[Move simple-form to golgonooza
clinton@unknownlamer.org**20081209070314] {
hunk ./src/packages.lisp 61
-  (:use :common-lisp :ucw-core :ucw-standard :ucw-forms :golgonooza :golgonooza-db
+  (:use :common-lisp :ucw-core :ucw-standard :ucw-forms
+	:golgonooza :golgonooza-db :golgonooza-forms
hunk ./src/packages.lisp 113
-   ;; Forms
-   :simple-form
-   :file-upload-form
-   :show-editor
-   :form-fields-of
-   :default-validp
-   :validp
hunk ./src/simple-form.lisp 1
-(in-package :com.tee-it-up-golf.web)
-
-(defcomponent simple-form (form-component-mixin)
-  ((%invalid :initform nil :accessor form-invalid-p)
-   (validators :initform nil :initarg :validators :accessor validators)
-   (%failed-validators :initform nil)
-   (%field-failed-validators :initform nil)))
-
-(defcomponent file-upload-form (simple-form)
-  ()
-  (:default-initargs :encoding-type "multipart/form-data"))
-
-(defmethod (setf form-invalid-p) :around (new-value (form simple-form))
-  (if (not new-value)
-      (setf (slot-value form '%failed-validators) nil
-	    (slot-value form '%field-failed-validators) nil))
-  (call-next-method))
-
-(defmethod form-field-validp ((form simple-form) field)
-  (multiple-value-bind (validp failed) (validp field)
-    (declare (ignore validp))
-    (let ((all-failed (append
-		       failed
-		       (cdr (assoc field
-				   (slot-value form '%field-failed-validators))))))
-      (values (null all-failed) all-failed))))
-
-(defclass form-validator (ucw-forms::validator)
-  ((field :initarg :field :initform nil :accessor field)))
-
-(defmethod ucw-forms::validate :around ((form simple-form) (validator form-validator))
-  (if (call-next-method)
-      t
-      (with-slots (field) validator
-	(if field
-	    (if-bind error-list-entry
-		(assoc (slot-value form field)
-		       (slot-value form '%field-failed-validators))
-	      (push validator (cdr error-list-entry))
-	      (push (list (slot-value form field) validator)
-		    (slot-value form '%field-failed-validators))))
-	nil)))
-
-(defmacro define-html-form (name (&rest supers)
-			    (&rest fields) (&rest slots)
-			    &rest options)
-  (flet ((massage-field-name (field-name)
-	   (if (listp field-name)
-	       (cons `(quote ,(car field-name)) (cdr field-name))
-	       (list `(quote ,field-name))))
-	 (massage-options (options)
-	   (if-bind validators (find :validators options :key #'car)
-	     `(,@(remove-if (lambda (k) (or (eq k :validators)
-				       (eq k :default-initargs)))
-			    options :key #'car)
-		 (:default-initargs
-		     ,@(cdr (find :default-initargs options :key #'car))
-		     :validators (list ,@(mapcar (lambda (v)
-						   `(make-instance ',(car v)
-								   ,@(cdr v)))
-						 (cdr validators)))))
-	     
-	     options)))
-    `(defcomponent ,name ,(or supers '(simple-form))
-       ,(append (mapcar (lambda (f)
-			  `(,(car f) :initform (make-instance
-						,@(massage-field-name (cadr f)))
-			     ,@(cddr f)))
-			fields)
-		slots)
-       ;; Need to yank out :validators and merge it with
-       ;; :default-initargs
-       ,@(massage-options options))))
-
-
-(defun make-validators (&rest validator-names)
-  "Create validator instances. validator-names should be a list of
-class names or sublists of class names and initargs"
-  (mapcar (lambda (name) (apply #'make-instance
-			   (if (listp name) name (list name))))
-	  validator-names))
-
-(defgeneric form-fields (form))
-
-(defgeneric/cc process-form (form))
-(defgeneric/cc cancel-form (form))
-
-(defmethod/cc cancel-form ((form simple-form))
-  (ok form))
-
-(defmethod/cc process-form :around ((form simple-form))
-  (multiple-value-bind (validp failed) (validp form)
-    (cond ((not validp)
-	   (setf (form-invalid-p form) t)
-	   (refresh-component form))
-	  (t (setf (form-invalid-p form) nil)
-	     (call-next-method form)))))
-
-(defmethod form-fields ((component simple-form))
-  (remove-if-not (arnesi:compose #'ucw-forms::form-field-p #'cdr)
-		 (mapcar (lambda (name) (cons name (slot-value component name)))
-			 (remove-if-not #'(lambda (name) (slot-boundp component name))
-					(mapcar #'c2mop:slot-definition-name
-						(c2mop:class-slots (class-of component)))))))
-
-(defmethod render ((form simple-form))
-  (<:div
-   :class "simple-form"
-   (if (form-invalid-p form)
-       (<:p :class "error"
-	    (<:h1 "Form Failed Validation")
-	    (if-bind failed-messages (mapcan (lambda (f)
-					       (if-bind msg (ucw-forms::message f)
-						 (list msg)))
-					     (slot-value form '%failed-validators))
-	      (mapc (lambda (m) (<:h2 (<:as-html m)))
-		    failed-messages))))
-   (mapc
-    (lambda (c)
-      (<:div
-       :class "field-box"		; composite field-box (car c)?
-       (<:div :class "label"
-	      (<:as-html (symbol->string  (car c)))
-	      (if (form-invalid-p form)
-		  (multiple-value-bind (validp failed)
-		      (form-field-validp form (cdr c))
-		    (if (not validp)
-			(<:p :class "error"
-			     (<:format "Invalid ~@[(~{~A~^, ~})~]"
-				       (mapcan (lambda (v)
-						 (if-bind msg (ucw-forms::message v)
-						   (list msg)
-						   msg))
-					       failed)))))))
-       (<:div :class "widget" (render (cdr c)))))
-    (form-fields form))))
-
-(defmethod render :after ((form simple-form))
-  (<:div 
-   (<ucw:submit :value "Ok" :action (process-form form))
-   (<ucw:submit :value "Cancel" :action (cancel-form form))))
-
-(defgeneric form-fields-of (component))
-
-(defmethod form-fields-of ((form simple-form))
-  (mapcar #'cdr (form-fields form)))
-
-(defmethod form-fields-of ((component standard-component))
-  "Return slot values of COMPONENT which are FORM-FIELDs"
-  (remove-if-not #'ucw-forms::form-field-p
-		 (mapcar (arnesi:curry #'slot-value component)
-			 (remove-if-not #'(lambda (name) (slot-boundp component name))
-					(mapcar #'c2mop:slot-definition-name
-						(c2mop:class-slots (class-of component)))))))
-
-(defmethod form-fields-of ((field form-field))
-  (list field))
-
-(defun default-validp (form)
-  ;; Mostly yanked from ucw update (C) notices
-  (flet ((do-validate-field (field)
-           "Run validators on FIELD, return list of (FIELD . VALIDATOR) conses."
-           (multiple-value-bind (validp failed) (validp field)
-             (declare (ignore validp))
-             (mapcar #'(lambda (failed) (cons field failed))
-                     failed))))
-    (let ((failed (apply #'nconc
-                         (mapcar #'do-validate-field
-                                 (form-fields-of form)))))
-      (values (null failed) failed))))
-
-(defmethod validp ((form standard-component))
-  (default-validp form))
-
-(defmethod validp ((form simple-form))
-  (setf (slot-value form '%failed-validators) nil
-	(slot-value form '%field-failed-validators) nil)
-  (multiple-value-bind (validp field-failed) (call-next-method)
-    (declare (ignore validp))
-    (let* ((form-failed
-	    (if-bind validators (validators form)
-	     (mapcan  (lambda (v)
-			(if (not (ucw-forms::validate form v))
-			    (list v)))
-		      validators)))
-	   (failed
-	    (nconc
-	     field-failed
-	     (mapcar (lambda (v) (cons form v))
-		     (setf (slot-value form '%failed-validators) form-failed))
-	     (mapcar (lambda (e) (cons (car e) (cdr e)))
-		     (slot-value form '%field-failed-validators)))))
-      (values (null failed) failed))))
-
-(defmethod validp ((form-field date-field))
-  (default-validp form-field))
-
-(defmethod form-fields-of ((field date-field))
-  (list (ucw-forms::year field) (ucw-forms::month field) (ucw-forms::day field)))
+
rmfile ./src/simple-form.lisp
hunk ./tee-it-up.asd 23
-     (:file "simple-form" :depends-on ("packages"))
-     (:file "web-admin" :depends-on ("web-common" "simple-form"))
+     (:file "web-admin" :depends-on ("web-common"))
}