removing historical implementation

[clinton/lisp-on-lines.git] / src / standard-wrappers.lisp

diff --git a/src/standard-wrappers.lisp b/src/standard-wrappers.lisp
index d902eb3..f54f1e6 100644 (file)
--- a/src/standard-wrappers.lisp
+++ b/src/standard-wrappers.lisp
@@ -25,13 +25,13 @@
 
 (defvar *link-wrapped-p* nil)
 
 
 (defvar *link-wrapped-p* nil)
 

-(define-layered-class description
+#+nil(define-layered-class description

   :in-layer wrap-link ()
   ((link :initarg :link-action
         :initarg :action
         :initform nil :special t :accessor link-action)))
 
   :in-layer wrap-link ()
   ((link :initarg :link-action
         :initarg :action
         :initform nil :special t :accessor link-action)))
 

-(defaction call-action-with--component-and-object ((self component) action-id object)
+(defmethod/cc call-action-with-component-and-object ((self component) action-id object)

   (funcall (ucw::find-action (ucw::context.current-frame *context*) action-id)
           self
           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))
        (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*)
                               self
                               (ucw::make-new-action
                                (ucw::context.current-frame *context*)


@@ -57,48 +57,62 @@
 ;;; wrap-a-form
 (deflayer wrap-form)
 
 ;;; wrap-a-form
 (deflayer wrap-form)
 

-(define-layered-class description
+(defvar *in-form-p* nil)
+
+#+nil(define-layered-class description

   :in-layer wrap-form ()
   :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 )
 
 (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)
                 
                 :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)
     (loop for button in (form-buttons description)
         do 
         (let ((button button))
           (with-properties (button)
             (let ((action (.get :action)))
               (submit :value (.get :value)

-                      :action action)))))))
+                      :action (if (consp action)
+                                  (eval 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)))))
+(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
 
 
 (deflayer wrap-div)
 
 
 ;;;; wrap a DIV
 
 
 (deflayer wrap-div)
 

-(define-layered-class description
+#+nil(define-layered-class description

   :in-layer wrap-div ()
   ((div-attributes :accessor div-attributes :initarg :div :special t :initform nil)))
 
   :in-layer wrap-div ()
   ((div-attributes :accessor div-attributes :initarg :div :special t :initform nil)))