[Move simple-form to ucw-forms
clinton@unknownlamer.org**20090206210109
 s/golgonooza-forms/ucw-simple-form/g
] {
hunk ./golgonooza.asd 15
-			 (:file "simple-form" :depends-on ("packages"))
hunk ./src/packages.lisp 49
-(defpackage :org.unknownlamer.golgonooza.forms
-  (:use :cl :ucw-core :ucw :ucw-forms)
-  (:import-from :arnesi :defgeneric/cc :defmethod/cc :if-bind)
-  (:import-from :metabang.utilities :symbol->string)
-  (:nicknames :golgonooza-forms)
-  (:export
-   ;; Simple Form
-   :simple-form
-   :file-upload-form
-   :form-invalid-p
-   :form-fields
-   
-   :form-validator
-   :make-validators
-
-   :process-form
-   :cancel-form
-
-   :define-html-form))
-
hunk ./src/simple-form.lisp 1
-;; simple-form.lisp --- 
-
-;; Copyright (C) 2008 Clinton Ebadi <clinton@unknownlamer.org>
-
-;; Author: Clinton Ebadi <clinton@unknownlamer.org>
-
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-(in-package :org.unknownlamer.golgonooza.forms)
-
-;;; Most of this will be merged into ucw-forms soon
-
-(defcomponent simple-form (form-component-mixin)
-  ((%invalid :initform nil :accessor form-invalid-p)
-   (validators :initform nil :initarg :validators :accessor validators)
-   (field-order :initform nil :accessor form-field-order :initarg :field-order)
-   (%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))))
-
-;; rename simple-form-validator in merge
-(defclass form-validator (validator)
-  ((field :initarg :field :initform nil :accessor field)))
-
-(defmethod 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))
-
-(defaction cancel-form ((form simple-form))
-  (answer nil))
-
-(defaction 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))
-  (let ((fields
-	 (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))))))))
-    (if (form-field-order component)
-	(mapcar (lambda (name) (find name fields :key #'car))
-		(form-field-order component))
-	fields)))
-
-(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 (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))))
-
-(defmethod form-fields-of ((form simple-form))
-  (mapcar #'cdr (form-fields 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))))
+
rmfile ./src/simple-form.lisp
}