Index: gadgets.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/gadgets.lisp,v
retrieving revision 1.94
diff -u -r1.94 gadgets.lisp
--- gadgets.lisp	1 Dec 2005 11:10:55 -0000	1.94
+++ gadgets.lisp	28 Dec 2005 21:24:06 -0000
@@ -2711,17 +2711,13 @@
 (defclass gadget-output-record (basic-output-record displayed-output-record)
   ((gadget :initarg :gadget :accessor gadget)))
 
-(defmethod initialize-instance :after ((record gadget-output-record) &key child x y)
-  (let* ((sr (compose-space child))
-         (width  (space-requirement-width sr))
-         (height (space-requirement-height sr)))
-    (allocate-space child width height)
-    (setf (gadget record) child
-          (rectangle-edges* record) (values x y (+ x width) (+ y height)))))
+(defmethod initialize-instance :after ((record gadget-output-record) &key x y)
+  (setf (output-record-position record) (values x y)))
 
 (defmethod note-output-record-got-sheet ((record gadget-output-record) sheet)
   (multiple-value-bind (x y)  (output-record-position record)
     (sheet-adopt-child sheet (gadget record))
+    (setup-gadget-record sheet record x y)
     (move-sheet (gadget record) x y)))
 
 (defmethod note-output-record-lost-sheet ((record gadget-output-record) sheet)
@@ -2742,14 +2738,25 @@
         (move-sheet (gadget record) ox oy)))))
 
 (defun setup-gadget-record (sheet record x y)
-  ;; Here we modify the height of the current text line. This is necessary so
-  ;; that when the cursor advances to the next line, it does not start writing
-  ;; underneath the gadget. This is probably a less than optimal solution.
-  (with-slots (height) sheet    
-    (setf height (max height (bounding-rectangle-height record))))
-  (setf (stream-cursor-position sheet)
-        (values (+ x (bounding-rectangle-width record))
-                y)))
+  ;; has to be called AFTER adoption
+  (let* ((child (gadget record))
+	 (sr (compose-space child))
+	 (width  (space-requirement-width sr))
+	 (height (space-requirement-height sr)))
+    (allocate-space child width height)
+    (setf (rectangle-edges* record) (values x y (+ x width) (+ y height)))
+
+    ;; Lispworks CLIM has an option :move-cursor t. Not sure how useful
+    ;; it is to set it NIL because next text gets written under gadget.
+    ;;
+    ;; BUG - Updating-output seems to clobber this cursor position adjustment
+    ;; 
+    (when t
+      ;; Almost like LWW, except baseline of text should align with bottom
+      ;; of gadget, not line below? FIXME
+      (setf (stream-cursor-position sheet)
+	    (values (+ x (bounding-rectangle-width record))
+		    (+ y (bounding-rectangle-height record)))))))
 
 ;; The CLIM 2.0 spec does not really say what this macro should return.
 ;; Existing code written for "Real CLIM" assumes it returns the gadget pane
@@ -2757,22 +2764,35 @@
 ;; For compatibility I'm having it return (values GADGET GADGET-OUTPUT-RECORD)
 
 (defmacro with-output-as-gadget ((stream &rest options) &body body)
-  (declare (type symbol stream)
-           (ignorable options))
-  (when (eq stream t)
-    (setq stream '*standard-output*))
-  (let ((gadget (gensym))
-	(gadget-output-record (gensym))
-        (x (gensym))
-        (y (gensym)))
-    `(multiple-value-bind (,x ,y)  (stream-cursor-position ,stream)
-       (let* ((,gadget (progn ,@body))
-              (,gadget-output-record (make-instance 'gadget-output-record
-                                                    :child ,gadget :x (round ,x) :y (round ,y))))
-         (stream-add-output-record ,stream ,gadget-output-record)
-         (setup-gadget-record ,stream ,gadget-output-record (round ,x) (round ,y))
-         (values ,gadget ,gadget-output-record)))))
-
+  ;; NOTE - incremental-redisplay 12/28/05 will call this on redisplay
+  ;; unless wrapped in (updating-output (stream :cache-value t) ...)
+  ;; Otherwise, new gadget-output-records are generated but only the first
+  ;; gadget is ever adopted, and an erase-output-record called on a newer
+  ;; gadget-output-record will face a sheet-not-child error when trying
+  ;; to disown the never adopted gadget.
+  (let ((gadget-output-record (gensym))
+	(x (gensym))
+	(y (gensym)))
+    `(multiple-value-bind (,x ,y)(stream-cursor-position ,stream)
+       (flet ((with-output-as-gadget-continuation (,stream record)
+		(flet ((with-output-as-gadget-body (,stream)
+			 (declare (ignorable ,stream))
+			 (progn ,@body)))
+		  (setf (gadget record)
+			(with-output-as-gadget-body ,stream))))
+	      (gadget-output-record-constructor ()
+		(make-instance 'gadget-output-record
+			       ,@options :x ,x :y ,y)))
+	 (declare (dynamic-extent with-output-as-gadget-continuation
+				  gadget-output-record-constructor))
+	 (let ((,gadget-output-record
+		(invoke-with-output-to-output-record
+		 ,stream
+		 #'with-output-as-gadget-continuation
+		 nil
+		 #'gadget-output-record-constructor)))
+	   (stream-add-output-record ,stream ,gadget-output-record)
+	   (values (gadget ,gadget-output-record) ,gadget-output-record))))))
 ;;; 
 
 (defclass orientation-from-parent-mixin () ())
Index: panes.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/panes.lisp,v
retrieving revision 1.165
diff -u -r1.165 panes.lisp
--- panes.lisp	1 Dec 2005 12:06:40 -0000	1.165
+++ panes.lisp	28 Dec 2005 21:24:08 -0000
@@ -2652,7 +2652,8 @@
   (let ((frame (pane-frame stream)))
     (when frame
       (disown-frame (frame-manager frame) frame)))
-  (call-next-method))
+  (when (next-method-p)
+    (call-next-method)))
 
 (define-application-frame a-window-stream (standard-encapsulating-stream
                                            standard-extended-input-stream