From a4e6154d961ff4b606aa534bd4e1570565cab351 Mon Sep 17 00:00:00 2001
From: Drew Crampsie <drewc@tech.coop>
Date: Tue, 21 Mar 2006 11:13:06 -0800
Subject: [PATCH] massive refactoring in preparation of release.

darcs-hash:20060321191306-5417e-444c1795d0a41eb2c9e15dcdb43a87536dc446ce.gz
---
 lisp-on-lines.asd                 |  4 ++
 patches/yaclml.lisp               | 15 +++++
 src/attributes/numbers.lisp       | 33 +++++++++--
 src/defdisplay.lisp               |  7 ++-
 src/dojo-attributes.lisp          | 33 ++++++-----
 src/lines.lisp                    | 33 +++++++++++
 src/mewa.lisp                     |  6 +-
 src/packages.lisp                 |  1 +
 src/relational-attributes.lisp    | 31 +++++++++-
 src/slot-presentations/date.lisp  | 28 ++++-----
 src/standard-attributes.lisp      | 94 ++++++++++++++++---------------
 src/standard-display.lisp         | 32 +++++++----
 src/standard-wrappers.lisp        | 44 +++++++++++----
 src/ucw-test-component.lisp       | 39 +++++++------
 src/validate-email-address.lisp   |  2 +-
 src/validation.lisp               |  6 +-
 src/validation/email-address.lisp |  2 +-
 17 files changed, 278 insertions(+), 132 deletions(-)
 create mode 100644 patches/yaclml.lisp
 create mode 100644 src/lines.lisp

diff --git a/lisp-on-lines.asd b/lisp-on-lines.asd
index 9629103..5f2637b 100644
--- a/lisp-on-lines.asd
+++ b/lisp-on-lines.asd
@@ -11,6 +11,8 @@
 (defsystem :lisp-on-lines
     :components ((:static-file "lisp-on-lines.asd")
 		 (:file "src/packages")
+		 (:module :patches			  
+			  :components ((:file "yaclml")))
 		 (:module :src
 			  :components ((:file "special-initargs")
 				       (:file "properties")
@@ -32,6 +34,8 @@
 				       (:file "standard-wrappers")
 				       (:file "relational-attributes")
 
+				       (:file "lines")
+
 				       (:file "backwards-compat"))
 			  :serial t)
 		 (:module :attributes
diff --git a/patches/yaclml.lisp b/patches/yaclml.lisp
new file mode 100644
index 0000000..6a7b26c
--- /dev/null
+++ b/patches/yaclml.lisp
@@ -0,0 +1,15 @@
+(in-package :yaclml)
+
+(defun funcall-with-tag (tag-spec thunk) 
+  (let ((%yaclml-code% nil) 
+	(%yaclml-indentation-depth% 0))
+    (declare (special %yaclml-code%))
+    ;; build tag's body
+    (dolist (i (fold-strings
+		(nreverse
+		 (funcall (gethash (car (ensure-list tag-spec)) *expanders*)
+			  (append (cdr tag-spec) (list
+						  thunk))))))
+      (if (functionp i)
+	  (funcall i)
+	  (write-string i *yaclml-stream*)))))
\ No newline at end of file
diff --git a/src/attributes/numbers.lisp b/src/attributes/numbers.lisp
index 8eeff63..6fb0460 100644
--- a/src/attributes/numbers.lisp
+++ b/src/attributes/numbers.lisp
@@ -5,22 +5,47 @@
   (:type-name number))
 
 ;;;; INTEGER
-(defattribute integer-attribute (base-attribute)
+(defattribute integer-attribute (number-attribute)
   ()
   (:type-name integer))
 
+
+(define-layered-method (setf attribute-value) ((value string) object (attribute integer-attribute)) 	       
+  (let ((*read-eval* nil))
+    (unless (string= "" value)
+      (let ((value (read-from-string value)))
+	(when (numberp value)
+	  (setf (attribute-value object attribute) value))))))
+
 ;;;; REALS
 
-(defattribute real-attribute (base-attribute)
+(defattribute real-attribute (number-attribute)
   ()
   (:type-name real))
 
+(define-layered-method (setf attribute-value) ((value string) object (attribute real-attribute))
+  (let ((*read-eval* nil))
+    (unless (string= "" value)
+      (let ((value (read-from-string value)))
+	(when (numberp value)
+	  (setf (attribute-value object attribute) value))))))
+
 
 ;;;; Currency
-(defattribute currency-attribute (base-attribute)
+(defattribute currency-attribute (real-attribute)
   ()
   (:type-name currency))
 
 (defdisplay
    ((currency currency-attribute) object)
- (<:as-html (format nil "$~$" (attribute-value object currency))))
+ (<:as-html "$")
+ (call-next-method))
+
+(defdisplay :in-layer editor
+   ((currency currency-attribute) object)
+    (<:as-html "$")
+    (<:input
+     :type "text"
+     :id (id currency)
+     :name (callback currency)
+     :value (format nil "~$" (or (attribute-value object currency) ""))))
diff --git a/src/defdisplay.lisp b/src/defdisplay.lisp
index 89f6987..9b4cb79 100644
--- a/src/defdisplay.lisp
+++ b/src/defdisplay.lisp
@@ -1,6 +1,7 @@
 (in-package :lisp-on-lines)
 
 (define-layered-function display-using-description (description object component)
+;  (:argument-precedence-order )
   (:documentation
    "Render the object in component, 
     using DESCRIPTION, which is an occurence, an attribute, or something else entirely."))
@@ -46,7 +47,7 @@
 	  (error "no description for ~A" object))))
 
 ;;;;; Macros
-;;;; TODO: " should really be a funcall-with function with a small wrapper."
+
 
 (defun funcall-with-description (description properties function &rest args)
   (if description
@@ -61,8 +62,8 @@
 	(funcall-with-layers 
 	 (description.layers description)
 	 #'(lambda ()
-	     (funcall-with-special-initargs
-	      description properties
+	     (contextl::funcall-with-special-initargs
+	      (list (cons description properties))
 	      #'(lambda ()
 		  (apply function args))))))
       (apply function args)))
diff --git a/src/dojo-attributes.lisp b/src/dojo-attributes.lisp
index 862ee11..8cb5447 100644
--- a/src/dojo-attributes.lisp
+++ b/src/dojo-attributes.lisp
@@ -3,39 +3,38 @@
 (deflayer dojo)
 
 (define-layered-class
-    attribute :in-layer dojo ()
+    description :in-layer dojo ()
   ((dojo-type :accessor dojo-type :initarg :dojo-type :initform nil :special t)))
 
-
-(defgeneric display-as-dojo-type (type attribute object component))
+(define-layered-function display-as-dojo-type (type description object component))
 
 (defdisplay
-  :in-layer dojo :after ((attribute standard-attribute) object)
- (when (dojo-type attribute)
-   (display-as-dojo-type (dojo-type attribute) attribute object self)))
+  :in-layer dojo :after (description object)
+ (when (dojo-type description)
+   (display-as-dojo-type (dojo-type description) description object self)))
 
-(defcomponent dojo-test (window-component)
-  (
-   (results :accessor results :initarg :results)))
+(defcomponent combo-results ()
+  ())
 
-(defmethod render ((self dojo-test))
+(defmethod render ((self combo-results))
   (<:as-is (js:js* `(array
 		     ,@(loop for r in (results self)
 			     for n upfrom 0
 			     collect `(array , 
 				       (with-output-to-string (s)
 					 (yaclml:with-yaclml-stream s
-					   (display self r :type 'as-string))) ,n))))))
+					   (display self r :type 'as-string)))
+				       ,n))))))
 
 
-(defmethod display-as-dojo-type ((type (eql 'combo-box)) attribute object component)
+(define-layered-method display-as-dojo-type ((type (eql 'combo-box)) attribute object component)
   
   (let* ((search-function (search-function attribute))
 	(select-function (select-function attribute))
-	(select-callback (ucw::make-new-callback (lambda (x)
-						   (warn "setting index to ~A" 							    (parse-integer x))
-						   (funcall select-function 
-							    (parse-integer x))))))
+	(select-callback (ucw::make-new-callback
+			  (lambda (x)
+			    (funcall select-function 
+				     (parse-integer x))))))
     "The combo box widget"
   (<ucw:script
    `(dojo.require "dojo.*")
@@ -54,7 +53,7 @@
 				 component
 				 (call-component
 				  (context.window-component *context*)
-				  (make-instance 'dojo-test
+				  (make-instance 'combo-results
 						 :results
 						 (funcall search-function
 							  (attribute-value object attribute)))))
diff --git a/src/lines.lisp b/src/lines.lisp
new file mode 100644
index 0000000..209271f
--- /dev/null
+++ b/src/lines.lisp
@@ -0,0 +1,33 @@
+(in-package :lisp-on-lines)
+
+(defmacro defline (name (specializer &rest layers-and-combination-keywords) &body docstring-and-body)
+  `(progn
+    ,(eval-when
+      (:compile-toplevel :load-toplevel :execute)
+      (unless (fboundp (contextl::get-layered-function-definer-name name)) 
+	`(define-layered-function ,name (arg)
+	  (:method-combination append))))
+    (define-layered-method
+	,name
+      ,@layers-and-combination-keywords
+      ,@(unless
+	 (or (third layers-and-combination-keywords)
+	     (and layers-and-combination-keywords
+		  (null (cdr layers-and-combination-keywords)))) 
+	 '(APPEND))
+      (,specializer)
+	,(when (cdr docstring-and-body)
+	       (car docstring-and-body))
+	
+	,(or (cdr docstring-and-body) (car docstring-and-body)))))
+
+
+(defun line-out (component object &key (line #'line-in) args)
+  (apply #'display component object (append args (funcall line object))))
+
+(defmacro call-line (from line &rest args)
+  (with-unique-names (lines object)
+    `(multiple-value-bind (,lines ,object)
+      (funcall ,line)
+      (call-display-with-context ,from ,object nil (append ,args ,lines)))))
+
diff --git a/src/mewa.lisp b/src/mewa.lisp
index 1b7d9e2..7c712ef 100644
--- a/src/mewa.lisp
+++ b/src/mewa.lisp
@@ -115,8 +115,6 @@ Attributes are the metadata used to display, validate, and otherwise manipulate
       (defmethod find-attribute-class-for-type ((type (eql ',type)))
 	',name))))
 
-
-
 (define-layered-class
     display-attribute (attribute)
     ()
@@ -263,11 +261,10 @@ otherwise, (setf find-attribute)"
 	       (when (slot-boundp instance (attribute.name attribute))
 		 (slot-value instance (attribute.name attribute)))))))
 
-(define-layered-function (setf attribute-value)  (value instance attribute))
+(define-layered-function (setf attribute-value) (value instance attribute))
 
 (define-layered-method
     (setf attribute-value) (value instance (attribute standard-attribute))
-	       
   (with-slots (setter slot-name) attribute 
     (cond ((and (slot-boundp attribute 'setter) setter)
 
@@ -280,6 +277,7 @@ otherwise, (setf find-attribute)"
 	   (error "Cannot set ~A in ~A" attribute instance)))))
 
 
+
 ;;;; ** Default Attributes
 
 
diff --git a/src/packages.lisp b/src/packages.lisp
index 66cb2ed..087b2f4 100644
--- a/src/packages.lisp
+++ b/src/packages.lisp
@@ -17,6 +17,7 @@
    :time-difference
    :make-time
    :time-ymd
+   :date-ymd
    :date
    :get-time
    :time-element
diff --git a/src/relational-attributes.lisp b/src/relational-attributes.lisp
index 2566023..58014f4 100644
--- a/src/relational-attributes.lisp
+++ b/src/relational-attributes.lisp
@@ -4,14 +4,28 @@
 
 
 ;;;; ** has-a
+;;;; Used for foreign keys, currently only works with clsql.
 
 (defattribute has-a ()
   ()
   (:default-properties
-      :has-a nil))
+      :has-a nil
+    :test 'meta-model::generic-equal))
 
+;;
 (define-layered-method attribute-value (object (attribute has-a))
  (meta-model:explode-foreign-key object (slot-name attribute) :nilp t))		       
+
+(define-layered-method (setf attribute-value) ((value standard-object) object (attribute has-a))
+  (let ((val (slot-value value (find-if (curry #'primary-key-p value) (list-keys value)))))
+    (setf (attribute-value object attribute) val)))
+
+
+
+(define-layered-function find-all-foreign-objects (o a))
+
+(define-layered-method find-all-foreign-objects (object (attribute has-a))
+  (select (meta-model:find-join-class object (slot-name attribute)) :flatp t))
 		       
 (defdisplay ((attribute has-a) object)
   (let ((args (plist-union (description.properties attribute) (has-a attribute)))
@@ -23,6 +37,18 @@
 	   args)))
 
 
+(defdisplay
+  :in-layer editor ((attribute has-a) object)
+ (<ucw:select
+  :accessor (attribute-value object attribute)
+
+  :test (test attribute)
+  (dolist* (obj (find-all-foreign-objects object attribute))
+    (<ucw:option
+     :value obj
+     (display* obj :type 'as-string)))))
+
+
 ;;;; ** Has-Many attribute
 
 (defattribute has-many ()
@@ -33,10 +59,9 @@
   (:default-initargs
       :type 'lol::one-line))
 
-
 (define-layered-method
     attribute-value (object (has-many has-many))
-  (slot-value object (slot-name has-many)))
+    (slot-value object (slot-name has-many)))
 
 (defdisplay ((attribute has-many) object)
     ;
diff --git a/src/slot-presentations/date.lisp b/src/slot-presentations/date.lisp
index ac34d9b..973f8fe 100644
--- a/src/slot-presentations/date.lisp
+++ b/src/slot-presentations/date.lisp
@@ -1,5 +1,20 @@
 (in-package :lol)
 
+(defclass form-element (widget-component)
+  ((client-value :accessor client-value :initform ""
+		 :initarg :client-value
+                 :documentation "Whetever the client's browse sent for this form element."
+                 :backtrack t)
+   (lisp-value :accessor lisp-value :initform +uninitialized+
+               :initarg :lisp-value
+               :documentation "The current lisp object in this form element."
+               :backtrack t))
+  (:metaclass standard-component-class)
+  (:documentation "A single value in a form.
+
+A form-element is, simply put, a wrapper for a value in an html
+form."))
+
 ;;;; Expiry date picker
 
 (defslot-presentation date-slot-presentation (clsql-wall-time-slot-presentation)
@@ -105,20 +120,7 @@ This obviously implies that you can't have a form element whose
 real value is +uninitialized+, since +uninitialized+ is a ucw
 internal symbol this shouldn't be a problem.")
 
-(defclass form-element (widget-component)
-  ((client-value :accessor client-value :initform ""
-		 :initarg :client-value
-                 :documentation "Whetever the client's browse sent for this form element."
-                 :backtrack t)
-   (lisp-value :accessor lisp-value :initform +uninitialized+
-               :initarg :lisp-value
-               :documentation "The current lisp object in this form element."
-               :backtrack t))
-  (:metaclass standard-component-class)
-  (:documentation "A single value in a form.
 
-A form-element is, simply put, a wrapper for a value in an html
-form."))
 
 (defgeneric read-client-value (element)
   (:method ((element form-element))
diff --git a/src/standard-attributes.lisp b/src/standard-attributes.lisp
index 87b8620..a34a1f6 100644
--- a/src/standard-attributes.lisp
+++ b/src/standard-attributes.lisp
@@ -27,25 +27,47 @@
 (defdisplay ((base base-attribute) object)
  (<:as-html (attribute-value object base)))
 
-;;;; Strings
 
-(defattribute string-attribute (base-attribute)
+(defattribute base-attribute ()
   ()
+  (:in-layer editor)
+  (:default-properties
+      :callback nil))
+
+(defdisplay
+    :in-layer editor :around ((string base-attribute) object)
+    (dletf (((callback string) (ucw::make-new-callback
+				#'(lambda (val)
+				    (setf (attribute-value object string) val)))))
+      (call-next-method)))
 
+;;;; Strings
+
+(defattribute string-attribute ()
+  ()
   (:type-name string)
   (:default-properties
       :escape-html-p t
     :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)))
    (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 +80,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 +95,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 +139,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 +150,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 +161,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")))
 
 
 
diff --git a/src/standard-display.lisp b/src/standard-display.lisp
index 1845491..a5b0f0e 100644
--- a/src/standard-display.lisp
+++ b/src/standard-display.lisp
@@ -3,16 +3,28 @@
 ;;;; The Standard Layers
 (deflayer viewer)
 (deflayer editor)
+
+(defdisplay
+    :in-layer editor :around (description object)
+ "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)))
+
 (deflayer creator)
 (deflayer one-line)
 (deflayer as-table)
+
+
+
 (deflayer as-string)
 
 (defdisplay
   :in-layer as-string (d o)
-  (do-attributes (a d)
-    (display-attribute a o)
-    (<:as-is " ")))
+  (with-inactive-layers (editor viewer creator one-line as-table label-attributes)
+    (do-attributes (a d)
+      (display-attribute a o)
+      (<:as-is " "))))
 
 (defmethod list-slots (thing)
   (list 'identity))
@@ -44,11 +56,7 @@
 
 ;;;; * Object displays.
 
-;;;; We like to have a label for attributes, and meta-model provides a default.
-(defdisplay ((desc (eql 'label)) label)
-  (<:span
-   :class "label"
-   (<:as-html label)))
+
 
 ;;;; TODO: all lisp types should have occurences and attributes defined for them.
 
@@ -89,10 +97,14 @@
 
 (defdisplay (description object)
  (<:div
-  :class "lol-display"	    
+  :class "lol-display"
+  (when (label description)
+    (<:span
+     :class "title"
+     (<:as-html (label description))))
   (do-attributes (attribute description)
     (<:div
-     :class "lol-attribute-row"
+     :class "attribute"
      (display-attribute attribute object)))))
 
 ;;;; ** One line
diff --git a/src/standard-wrappers.lisp b/src/standard-wrappers.lisp
index bb24876..e9c0b48 100644
--- a/src/standard-wrappers.lisp
+++ b/src/standard-wrappers.lisp
@@ -3,16 +3,21 @@
 ;;;;; Wrap a display in "back buttons"
 (deflayer wrap-back-buttons)
 
+(defvar *back-buttons-wrapped-p* nil)
+
 (defdisplay
-    :in-layer wrap-back-buttons :around
-    (description object)
-    
-    (<ucw:a :class "wiz-button previous" :action (ok component t)
-	    (<:as-html "Go Back"))
-    (<:div :style "clear:both;"
-	   (call-next-method))
-    (<ucw:a :class "wiz-button previous" :action (ok component t)
-	    (<:as-html "Go Back")))
+  :in-layer wrap-back-buttons :around
+  (description object)
+  (if  *back-buttons-wrapped-p*
+       (call-next-method)
+       (let ((*back-buttons-wrapped-p* t))
+	
+	 (<ucw:a :class "wiz-button previous" :action (ok self t)
+		 (<:as-html "Go Back"))
+	 (<:div :style "clear:both;"
+		(call-next-method))
+	 (<ucw:a :class "wiz-button previous" :action (ok self t)
+		 (<:as-html "Go Back")))))
 
 ;;;; Wrap an object display in with a link to the object
 
@@ -51,4 +56,23 @@
 
      (call-next-method)
      ;(display* 'standard-form-buttons)
-   )))
\ No newline at end of file
+     )))
+
+;;;; wrap a DIV
+
+
+(deflayer wrap-div)
+
+(define-layered-class description
+  :in-layer wrap-div ()
+  ((div-attributes :accessor div-attributes :initarg :div :special t :initform nil)))
+
+(defdisplay :in-layer wrap-div :around (description object)
+ (let ((args (div-attributes description)))
+   (with-inactive-layers (wrap-div)
+     (yaclml::funcall-with-tag
+      (cons '<:div args)
+      (lambda ()
+	(call-next-method))))))
+
+     
\ No newline at end of file
diff --git a/src/ucw-test-component.lisp b/src/ucw-test-component.lisp
index bca8dc1..477375e 100644
--- a/src/ucw-test-component.lisp
+++ b/src/ucw-test-component.lisp
@@ -1,18 +1,32 @@
 (in-package :lisp-on-lines)
 
-;;;; LoL CLOS Test Class
+;;;; LoL CLOS Tests
+;;;; 
 (defclass lol-test-class ()
-  ((test-string :initform "test string"))
+  ((test-slot-value :initform "slot-value")
+   (test-string :initform "Test String"))
   (:documentation "foo"))
 
-(set-default-attributes 'lol-test-class)
+(defvar *foo* nil)
+
+(defvar *standard-layers* '(viewer editor creator one-line as-string))
 
 (define-attributes (lol-test-class)
-  (test-string t :label "String :"))
+  (test-getter t
+	       :label "Getter"
+	       :getter (constantly "Hello World"))
+  (test-getter/setter t
+	       :label "Getter/Setter:"
+	       :getter (lambda ()
+			 *foo*)
+	       :setter #'(lambda (value)
+			   (setf *foo* value)))
+  (test-slot-value t)
+  (test-string string :label "String" :documentation))
   
 (defcomponent test-component ()
-  ((display-types :accessor display-types :initform (list 'viewer 'editor 'creator 'one-line 'as-string))
-   (current-type :accessor current-type :initform 'viewer)
+   (current-layer :accessor current-type :initform 'viewer)
+   (layer-spec :accessor layer-spec :initform nil)
    (instance :accessor instance :initform (make-instance 'test-class))))
 
 (defmethod render ((self test-component))
@@ -21,22 +35,13 @@
     (with-component (self)
       (<ucw:form
        :action (refresh-component self)
-       (<ucw:select :accessor (current-type self)
+       (<ucw:select :accessor (current-layer self)
 		    (dolist* (type (display-types self))
 		      (<ucw:option :value type (<:as-html type))))
        (<:input :type "Submit" :value "update")
        (<:fieldset
 	(<:legend (<:as-html (current-type self)))
-	(display test :type (current-type self)))))
-
-    (<:div
-     (<:h2
-      (<:as-html "UCW Presentation based displays (the old school"))
-     (dolist (type '(:viewer :editor :creator :one-line :as-string))
-       (<:h3 (<:as-html type))
-       (present-view (test type self))
-       (<ucw:a :action (call-view (test type self))
-	       (<:as-html "Call to " type))))))
+	(display test :type (current-type self)))))))
 
 
 (defcomponent standard-display-component ()
diff --git a/src/validate-email-address.lisp b/src/validate-email-address.lisp
index 8f3712d..ede7ae1 100644
--- a/src/validate-email-address.lisp
+++ b/src/validate-email-address.lisp
@@ -22,5 +22,5 @@
 	 (not (< 0 (length value))))
 	(signal 'attribute-validation-condition
 		:message (format nil "You must enter a value for ~A."
-			      (getf (attribute.plist attribute) :label))
+				 (getf (description.properties attribute) :label))
 		:attribute attribute))))
\ No newline at end of file
diff --git a/src/validation.lisp b/src/validation.lisp
index d013218..00cade6 100644
--- a/src/validation.lisp
+++ b/src/validation.lisp
@@ -30,7 +30,7 @@ Returns T if the ATTRIBUTE-VALUE in INSTANCE passes all the validation functions
 
 
 (defmethod find-validation-functions (instance (attribute standard-attribute))
-  (getf (attribute.plist attribute) :validate-using))
+  (getf (description.properties attribute) :validate-using))
 
 
 ;;;; ** Instances
@@ -73,7 +73,7 @@ Returns T if the ATTRIBUTE-VALUE in INSTANCE passes all the validation functions
 	 (not (< 0 (length value))))
 	(signal 'attribute-validation-condition
 		:message (format nil "You must enter a value for ~A."
-			      (getf (attribute.plist attribute) :label))
+				 (getf (description.properties attribute) :label))
 		:attribute attribute))))
 
 
@@ -86,7 +86,7 @@ Returns T if the ATTRIBUTE-VALUE in INSTANCE passes all the validation functions
 	 
       (signal 'attribute-validation-condition
 	      :message (format nil "~A must be true."
-			       (getf (attribute.plist attribute) :label))
+			       (getf (description.properties attribute) :label))
 	      :attribute attribute))))
 
 
diff --git a/src/validation/email-address.lisp b/src/validation/email-address.lisp
index 3c1c78a..9160f25 100644
--- a/src/validation/email-address.lisp
+++ b/src/validation/email-address.lisp
@@ -24,5 +24,5 @@
       (when (not (and (equal start 0) (equal end (length value))))
 	(signal 'attribute-validation-condition
 		:message (format nil "~A must be a valid email address."
-			      (getf (attribute.plist attribute) :label))
+				 (getf (description.properties attribute) :label))
 		:attribute attribute)))))
\ No newline at end of file
-- 
2.20.1