X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/ff1e971a04b479bbee88fb8c3ee34d83ec148203..e9c163726f466dee83a8dbe7d952f6aaff4345b6:/src/standard-wrappers.lisp?ds=sidebyside

diff --git a/src/standard-wrappers.lisp b/src/standard-wrappers.lisp
index d902eb3..110bdd3 100644
--- a/src/standard-wrappers.lisp
+++ b/src/standard-wrappers.lisp
@@ -31,7 +31,7 @@
 	 :initarg :action
 	 :initform nil :special t :accessor link-action)))
 
-(defaction call-action-with--component-and-object ((self component) action-id object)
+(defaction call-action-with-component-and-object ((self component) action-id object)
   (funcall (ucw::find-action (ucw::context.current-frame *context*) action-id)
 	   self
 	   object))
@@ -44,7 +44,7 @@
 	(if *link-wrapped-p*
 	    (call-next-method)
 	    (let ((*link-wrapped-p* t))
-	      (<ucw:a :action (call-action-with--component-and-object
+	      (<ucw:a :action (call-action-with-component-and-object
 			       self
 			       (ucw::make-new-action
 				(ucw::context.current-frame *context*)
@@ -57,41 +57,55 @@
 ;;; wrap-a-form
 (deflayer wrap-form)
 
+(defvar *in-form-p* nil)
+
 (define-layered-class description
   :in-layer wrap-form ()
-  ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
+  ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)
+   (form-type :initarg :form-type :initform '<ucw:simple-form :special t :accessor form-type)))
 
 (defattribute form-button-attribute ()
   ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
 
 (defdisplay ((description form-button-attribute) object)	    
   (macrolet ((submit (&key action value )
-	       `(<ucw::simple-submit
+	       `(<ucw::value-submit
 		 :action (funcall ,action self object)
 		 
-		 (<:as-html ,value))))
+		 :value ,value)))
     (loop for button in (form-buttons description)
 	 do 
 	 (let ((button button))
 	   (with-properties (button)
 	     (let ((action (.get :action)))
 	       (submit :value (.get :value)
-		       :action action)))))))
-
-
-
-(defdisplay :in-layer wrap-form :around (description object)
-  (<ucw:form
-   :action (refresh-component self)
-   (with-inactive-layers (wrap-form)
-     (call-next-method)
-     (with-inactive-layers (show-attribute-labels)
-       (display-attribute
-	(make-instance
-	 'form-button-attribute
-	 :form-buttons
-	 (form-buttons description))
-	object)))))
+		       :action (if (consp action)
+				   (eval action)
+				   action))))))))
+
+
+(defdisplay
+  :in-layer wrap-form
+  :around (description object)
+  (flet ((body ()
+	   (with-inactive-layers (wrap-form)
+	     (call-next-method)
+	     (with-inactive-layers (show-attribute-labels)
+	       (display-attribute
+		(make-instance
+		 'form-button-attribute
+		 :form-buttons
+		 (form-buttons description))
+		object)))))
+    (ecase (form-type description)
+      ('<ucw:simple-form
+       (<ucw:simple-form
+	:action (refresh-component self)
+	(body)))
+      ('<ucw:form
+       (<ucw:form
+	:action (refresh-component self)
+	(body))))))
 
 ;;;; wrap a DIV