fixed up wrappers .. we are this close to being fully functional!
authordrewc <drewc@tech.coop>
Tue, 30 May 2006 01:19:13 +0000 (18:19 -0700)
committerdrewc <drewc@tech.coop>
Tue, 30 May 2006 01:19:13 +0000 (18:19 -0700)
darcs-hash:20060530011913-39164-0d1c244ae45ccc66a4cd00a76e9c3149f8a4538e.gz

src/standard-display.lisp
src/standard-occurence.lisp
src/standard-wrappers.lisp

index 0fe6df5..bc1297c 100644 (file)
@@ -41,6 +41,9 @@ This allows us to dispatch to a subclasses editor."
 (defdisplay (description (object string))
   (<:as-html object))
 
+(defdisplay (description (object symbol))
+  (<:as-html object))
+
 (defdisplay (description object (component t))
   "The default display for CLOS objects"
   (print (class-name (class-of object)))
index bb2f686..eeef240 100644 (file)
@@ -1,3 +1,4 @@
+
 (in-package :lisp-on-lines)
 
 ;;;; STRINGS
index 43151ca..d902eb3 100644 (file)
 
 (define-layered-class description
   :in-layer wrap-link ()
-  ((link :initarg :link :initform nil :special t :accessor link)))
+  ((link :initarg :link-action
+        :initarg :action
+        :initform nil :special t :accessor link-action)))
 
-(defdisplay
-  :in-layer wrap-link :around (description object)
-  (let ((link (link description)))
+(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))
 
-    (with-inactive-layers (wrap-link)
-      (if *link-wrapped-p*
-         (call-next-method)
-         (let ((*link-wrapped-p* t))
-           (<ucw:a :action (call-display self object link)
-                   (call-next-method)))))))
+(defdisplay
+    :in-layer wrap-link :around (description object)
+    (let ((link (link-action description)))
+
+      (with-inactive-layers (wrap-link)
+       (if *link-wrapped-p*
+           (call-next-method)
+           (let ((*link-wrapped-p* t))
+             (<ucw:a :action (call-action-with--component-and-object
+                              self
+                              (ucw::make-new-action
+                               (ucw::context.current-frame *context*)
+                               (if (consp link)
+                                   (eval link)
+                                   link))
+                              object)
+                     (call-next-method)))))))
 
 ;;; wrap-a-form
 (deflayer wrap-form)
   :in-layer wrap-form ()
   ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
 
+(defattribute form-button-attribute ()
+  ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
 
-(defdisplay ((description (eql 'standard-form-buttons)) description-object)        
+(defdisplay ((description form-button-attribute) object)           
   (macrolet ((submit (&key action value )
               `(<ucw::simple-submit
-                :action (funcall ,action)
+                :action (funcall ,action self object)
                 
                 (<:as-html ,value))))
-    (loop for button in (form-buttons description-object)
+    (loop for button in (form-buttons description)
         do 
         (let ((button button))
           (with-properties (button)
   (<ucw:form
    :action (refresh-component self)
    (with-inactive-layers (wrap-form)
-
      (call-next-method)
-     (display-attribute 'standard-form-buttons description))))
+     (with-inactive-layers (show-attribute-labels)
+       (display-attribute
+       (make-instance
+        'form-button-attribute
+        :form-buttons
+        (form-buttons description))
+       object)))))
 
 ;;;; wrap a DIV
 
   :in-layer wrap-div ()
   ((div-attributes :accessor div-attributes :initarg :div :special t :initform nil)))
 
-(defdisplay :in-layer wrap-div :around (description object)
+(defdisplay :in-layer wrap-div :wrap-around (description object)
  (let ((args (div-attributes description)))
    (with-inactive-layers (wrap-div)
      (yaclml::funcall-with-tag