diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index 4f83bac417d6cca7d97b18e0b054e93cb9e94aa1..ff8658c244dbf65b528aeaefdfad846baa35478a 100644
--- a/clim/accept-values.lisp
+++ b/clim/accept-values.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: accept-values.lisp,v 1.5 92/01/31 14:57:29 cer Exp Locker: cer $
+;; $fiHeader: accept-values.lisp,v 1.6 92/02/05 21:45:37 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -161,37 +161,43 @@
 	query))))
 
 (define-application-frame accept-values ()
-    ((stream :initarg :stream)
-     (continuation :initarg :continuation)
-     (own-window :initform nil :initarg :own-window)
-     (own-window-x-position :initform nil :initarg :x-position)
-     (own-window-y-position :initform nil :initarg :y-position)
-     (own-window-width :initform nil :initarg :width)
-     (own-window-height :initform nil :initarg :height)
-     (own-window-right-margin :initform nil :initarg :right-margin)
-     (own-window-bottom-margin :initform nil :initarg :bottom-margin)
-     (exit-boxes :initform nil :initarg :exit-boxes)
-     (selected-item :initform nil)
-     ;;--- Do this through RUN-FRAME-TOP-LEVEL?
-     (initially-select-query-identifier :initform nil
-					:initarg :initially-select-query-identifier)
-     (resynchronize-every-pass :initform nil :initarg :resynchronize-every-pass)
-     (check-overlapping :initform t :initarg :check-overlapping))
+  ((stream :initarg :stream)
+   exit-button-stream
+   (calling-frame :reader frame-calling-frame
+		  :initarg :calling-frame)
+   (continuation :initarg :continuation)
+   (own-window :initform nil :initarg :own-window)
+   (own-window-x-position :initform nil :initarg :x-position)
+   (own-window-y-position :initform nil :initarg :y-position)
+   (own-window-width :initform nil :initarg :width)
+   (own-window-height :initform nil :initarg :height)
+   (own-window-right-margin :initform nil :initarg :right-margin)
+   (own-window-bottom-margin :initform nil :initarg :bottom-margin)
+   (exit-boxes :initform nil :initarg :exit-boxes)
+   (selected-item :initform nil)
+   ;;--- Do this through RUN-FRAME-TOP-LEVEL?
+   (initially-select-query-identifier :initform nil
+				      :initarg :initially-select-query-identifier)
+   (resynchronize-every-pass :initform nil :initarg :resynchronize-every-pass)
+   (check-overlapping :initform t :initarg :check-overlapping))
   (:top-level (accept-values-top-level))
   (:command-definer t))
 
 (define-application-frame accept-values-own-window (accept-values)
     ()
   (:pane 
-   (with-slots (stream own-window) *application-frame*
-     (scrolling ()
-       (progn
-	 (setq stream
-	   (make-instance 'accept-values-stream
-			  :stream (setf own-window
-				        (realize-pane 'extended-stream-pane
-						      :initial-cursor-visibility nil))))
-	 own-window))))
+   (with-slots (stream own-window exit-button-stream) *application-frame*
+     (vertically ()
+		 (progn
+		   (setq stream
+		     (make-instance 'accept-values-stream
+				    :stream (setf own-window
+					      (realize-pane 'extended-stream-pane
+							    :initial-cursor-visibility nil))))
+		   own-window)
+		 (setf exit-button-stream
+			      (realize-pane 'extended-stream-pane
+					    :initial-cursor-visibility nil)))))
   (:menu-bar nil)
   (:command-table accept-values)
   (:command-definer nil))
@@ -270,19 +276,20 @@
 	 (bottom-margin 10))
      (if own-window
 	 (let ((frame (make-application-frame (or frame-class 'accept-values-own-window)
-						  :continuation continuation
-						  :exit-boxes exit-boxes
-						  :own-window the-own-window
-						  :x-position x-position
-						  :y-position y-position
-						  :right-margin right-margin
-						  :bottom-margin bottom-margin
-						  :initially-select-query-identifier
-						    initially-select-query-identifier
-						  :resynchronize-every-pass
-						    resynchronize-every-pass
-						  :check-overlapping
-						    check-overlapping)))
+					      :calling-frame *application-frame*
+					      :continuation continuation
+					      :exit-boxes exit-boxes
+					      :own-window the-own-window
+					      :x-position x-position
+					      :y-position y-position
+					      :right-margin right-margin
+					      :bottom-margin bottom-margin
+					      :initially-select-query-identifier
+					      initially-select-query-identifier
+					      :resynchronize-every-pass
+					      resynchronize-every-pass
+					      :check-overlapping
+					      check-overlapping)))
 	   ;; What do we do about sizing?????
 	   ;; What do we do about positioning????
 	   (let ((*avv-calling-frame* *application-frame*))
@@ -317,11 +324,13 @@
 	       selected-item initially-select-query-identifier
 	       own-window own-window-x-position own-window-y-position
 	       own-window-width own-window-height
-	       own-window-right-margin own-window-bottom-margin) frame
+	       own-window-right-margin own-window-bottom-margin
+	       exit-button-stream) frame
     (let ((command-table (frame-command-table frame))
 	  (original-view (stream-default-view stream))
 	  (return-values nil)
 	  (initial-query nil)
+	  exit-button-stuff
 	  avv avv-record)
       (letf-globally (((stream-default-view stream) 
 		       (port-dialog-view (sheet-port stream))))
@@ -330,9 +339,13 @@
 		 (setf (slot-value stream 'avv-frame) frame)
 		 (with-output-recording-options (stream :draw nil :record t)
 		   (setq return-values (multiple-value-list
-					 (let ((*application-frame* *avv-calling-frame*))
-					   (funcall continuation stream))))
-		   (display-exit-boxes frame stream (stream-default-view stream))))
+					   (let ((*application-frame* *avv-calling-frame*))
+					     (funcall continuation
+						      stream)))))
+		 (unless own-window
+		   (display-exit-boxes frame 
+				       stream
+				       (stream-default-view stream))))
 	       (run-avv ()
 		 (when (and initially-select-query-identifier
 			    (setq initial-query
@@ -360,6 +373,8 @@
 		     (with-output-recording-options (stream :draw nil)
 		       (redisplay avv stream :check-overlapping check-overlapping)))
 		   (setf (slot-value avv-record 'resynchronize) nil)
+		   (when exit-button-stuff
+		     (redisplay exit-button-stuff exit-button-stream))
 		   (redisplay avv stream :check-overlapping check-overlapping))))
 	  (declare (dynamic-extent #'run-continuation #'run-avv))
 	  (with-simple-restart (frame-exit "Exit from the ACCEPT-VALUES dialog")
@@ -370,9 +385,23 @@
 			    (with-end-of-page-action (stream :allow)
 			      (with-new-output-record
 				  (stream 'accept-values-output-record avv-record)
-				(run-continuation stream avv-record)))))))
+				(run-continuation stream
+						  avv-record)))))))
+
+	    ;; In own window dialogs the buttons are displayed
+	    ;; separately
+	    
+	    (when own-window
+	      (setq exit-button-stuff 
+		    (updating-output (exit-button-stream)
+				     (with-end-of-line-action (exit-button-stream :allow)
+				       (with-end-of-page-action (exit-button-stream :allow)
+					 (display-exit-boxes frame 
+							     exit-button-stream
+							     (stream-default-view stream)))))))
 	    (unwind-protect
 		(cond (own-window
+		       (size-menu-appropriately exit-button-stream)
 		       (size-menu-appropriately own-window
 						:width own-window-width
 						:height own-window-height
@@ -390,6 +419,7 @@
 			 (position-window-near-carefully own-window x y))
 		       (window-expose own-window)
 		       (with-input-focus (own-window)
+			 (replay exit-button-stuff exit-button-stream)
 			 (replay avv stream)
 			 (run-avv)))
 		      (t
diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp
index e7b00a9002023474e94a5e7140137bd166d5406f..1a149873238a72f6adcff4f88591ccc8d160d17b 100644
--- a/clim/db-stream.lisp
+++ b/clim/db-stream.lisp
@@ -21,7 +21,7 @@
 ;;;
 ;;; Copyright (c) 1990 by Xerox Corporations.  All rights reserved.
 ;;;
-;; $fiHeader: db-stream.lisp,v 1.5 92/01/06 20:44:18 cer Exp $
+;; $fiHeader: db-stream.lisp,v 1.6 92/01/31 14:57:47 cer Exp Locker: cer $
 
 
 (in-package :clim-internals)
@@ -42,11 +42,12 @@
 
 ;;; Communicate with output-protocol what the new text constraints are.
 
-(defmethod note-sheet-region-changed ((pane clim-pane-stream-mixin) &key &allow-other-keys)
+(defmethod note-sheet-region-changed :after  ((pane clim-pane-stream-mixin) &key &allow-other-keys)
   (let ((viewport (pane-viewport pane)))
-    (when viewport
-	  (setf (stream-default-text-margin pane)
-	    (bounding-rectangle-width (sheet-region (pane-viewport pane)))))))
+    (setf (stream-default-text-margin pane)
+      (if viewport
+	  (bounding-rectangle-width (sheet-region (pane-viewport pane)))
+	(bounding-rectangle-width pane)))))
 
 ;;; Communicate with output-protocol what the new text constraints are.
 
diff --git a/clim/menus.lisp b/clim/menus.lisp
index d103a1c8e591027b6982a598eecc729e476cff59..51c37105bf4883322272c736fd57861bb6114e97 100644
--- a/clim/menus.lisp
+++ b/clim/menus.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: menus.lisp,v 1.7 92/01/31 14:58:22 cer Exp Locker: cer $
+;; $fiHeader: menus.lisp,v 1.8 92/02/05 21:45:43 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -20,6 +20,8 @@
 					 nil)))))
   (:menu-bar nil))
 
+(defmethod frame-calling-frame ((frame menu-frame))
+  *application-frame*)
 
 (defun get-menu (&key server-path)
   (let ((frame (make-application-frame 'menu-frame)))
@@ -110,23 +112,18 @@
 	     (gh (bounding-rectangle-height (sheet-region graft)))
 	     (width (min gw (+ (- maxx minx) right-margin)))
 	     (height (min gh (+ (- maxy miny) bottom-margin))))
-	(change-space-requirement menu :width width :height height)
-	;; --- Damn.  How do we get this to propagate the size change up
-	;; the tree so that the whole frame gets re-size to the pane?
-	;; For now, kludge it by setting the frame size directly.
-	;; Allow for scroll bar width
-	
-	(layout-frame (pane-frame menu))
-	
-	;; (when vw (change-space-requirement vw :hs width :vs height))
-	;; (resize-sheet* menu width height)
-	(silica::clear-space-requirement-caching-in-ancestors menu)
-	;; --- RR needs to fix this at some point.
-	;; --- It has to do with the viewport having a bad scrolling transform
-	;; after a resize.
-	#+ignore
-	(setf (sheet-transformation (sheet-parent menu))
-	      (make-translation-transformation 0 0))))))
+	(window-set-inside-size menu width height)
+	(window-set-viewport-position* menu minx miny)))))
+
+;;;---- should be somewhere else
+
+(defmethod (setf window-label) (nv window)
+  nil)
+
+(defun window-set-inside-size (menu width height)
+  (change-space-requirement menu :width width :height height)
+  (silica::clear-space-requirement-caching-in-ancestors menu)
+  (layout-frame (pane-frame menu)))
 
 #-Silica
 (defun position-window-near-carefully (window x y)
diff --git a/notes/clim.todo b/notes/clim.todo
index 0526f07909d1675e60260ba5ad7bb64b230015cf..4919de37e906c2f4f50353f0e705549eb173253d 100644
--- a/notes/clim.todo
+++ b/notes/clim.todo
@@ -1,91 +1,195 @@
 %%  $fiHeader: clim.todo,v 1.1 92/02/10 17:51:12 cer Exp Locker: cer $
 %%%%%%%%%%%%%%%%%%%%%%%%% CLIM 2.0 plan
 
-
-% Silica backends
+% Silica back-ends
   * Genera
+  * Raw CLX
   * Xt
     - Motif
     - OpenLook
   * Postscript
 
-% Performance
-  * Make use of volatile regions and transformations
-  * Simplify transformation classes
-  * (deftype coordinate () )
-  * Ink caches
-  * Sheet region and transformation caches.
-  * Meet CLIM 1.0 performance goals
-  * Surpass CLIM 1.0 performance goals
-
-% Size issues
-  * Modularize with load on demand/required modules
-    - Regions
-    - Transformations
-
-% Holes to Fill-in
-  * Rename defsys package to clim-defsys
-  * Reinstate clipping regions
-  * Complete abstract gadgetsd
-  * Gesture stuff
-  * Reinstate Menubars
-  * Stream defprotocols
-  * Layout for gadgets within accepting-values
-  * Implement clean interface to throw-to-highlighted-presentation
-  * Interprocess communication, i.e one process to another to execute
-    a frame command.
-  * accepting-values :own-window architecture that allows integration
-    with toolkit dialogs
-  * Temporary-medium sheets
-    - medium accessors on a sheet with no medium?
-    - temporary medium need to have their state decached
-  * Sheet protocol 
+% Holes to fill in
+  * Rename DEFSYS package to CLIM-DEFSYS.
+  * Reinstate clipping regions.
+  * Complete abstract gadgets.
+    - Take whatever is needed from ILA CLIM in order to get the non-adaptive
+      gadgets together. 
+  * Write a "null" frame manager that implements the same look and feel for all
+    ports.
+    - Genera's frame manager will inherit from this.
+  * Take the keyboard gesture stuff code from ILA CLIM, but make it more
+    cons-efficient.
+  * Reinstate CLIM 0.9's :MENU-GROUP, but call it :MENU-BAR. 
+    - NIL means no menu bar.
+    - T means use the current command table.
+    - A symbol names the command table to use.
+  * Stream defprotocols: be sure that all of the sheet and medium protocol
+    functions are explicitly defined with DEFOPERATION so that the stream
+    trampolines are properly created.
+  * Layout for gadgets within ACCEPTING-VALUES.
+  * ACCEPTING-VALUES :OWN-WINDOW architecture that allows integration with
+    toolkit dialogs.
+    - For example, :OWN-WINDOW T dialogs should use a separate pane to hold the
+      Exit and Abort buttons.
+  * Implement clean interface to THROW-HIGHLIGHTED-PRESENTATION.
+    - SWM claims that it is already clean.  Why do SWM and CER disagree?
+  * Interprocess communication, i.e., one process to another to execute a frame
+    command. 
+  * Temporary-medium sheets.
+    - Medium accessors on a sheet with no medium?
+    - Temporary medium need to have their state decached.
+  * Sheet protocol.
     - Where do event queues come from?
-    - Repaint protocol: who clears the area, sets the clipping region
-      when doing the repaint.
-    - How do we deal with the case where a sheet as one children and its
-    mirror allows one children only but the sheet actually has two children
-    (frame (horizontally () () ()))
-    - What is the precise value returned by event-sheet? Does the
-      event-sheet accessor return the sheet that the event was
-      dispatched to?
-  * Why does input-protocol-mixin define an input-buffer? Whats wrong
-    with the sheet-event queue?
-  * Multiple-layouts need to allow different size reqs for the sheets
-  * Implement :compute size spec
-  * Protocol to compute to the wm the desired geometry of the frame
-  * The code for switching layouts needs to be cleanup
-  * When the viewport is resized in might need to be moved, for
-    example, if it becomes big enough to display the entire window: In
-    the allocate-space for viewport.
+    - Repaint protocol: who clears the area and sets the clipping region when
+      doing the repaint?
+    - How do we deal with the case where a sheet has one children and its
+      mirror allows one children only but the sheet actually has two children,
+      e.g., (FRAME (HORIZONTALLY () () ())).
+    - What is the precise value returned by EVENT-SHEET?  Does the EVENT-SHEET
+      accessor return the sheet that the event was dispatched to?
+  * Why does INPUT-PROTOCOL-MIXIN define an input buffer?  What's wrong with the
+    sheet event queue?
+  * Multiple layouts need to allow different size reqs for the sheets.
+  * The code for switching layouts needs to be cleaned up.
+  * Implement :COMPUTE size spec, that is, panes that get their size from the
+    size of the output in the pane. 
+  * Implement compatibility code for CLIM 1.0's :LAYOUT language.
+  * Protocol to compute to the WM the desired geometry of the frame.
+  * When the viewport is resized in might need to be moved, for example, if it
+    becomes big enough to display the entire window: in the ALLOCATE-SPACE for
+    viewport. 
   * Pointer documentation panes and other pane types,
-  * Gadget-enable/disable protocol
+  * Gadget enable/disable protocol.
   * Event protocol:
-    - Consider design of distribute-event
-    - timestamp
-    - native-region
-  * On demand scrollbars
+    - Consider design of DISTRIBUTE-EVENT.
+    - Timestamp.
+    - Native region.
+  * On-demand scrollbars.
+  * Should we do "stream relative" coordinates (as opposed to the current
+    "parent relative" scheme) for output records?  It solves some problems, but
+    introduces others. 
+  * Should we divide the drawing protocol into a medium and a port layer, or
+    should it be a single layer as Bill suggests? 
+  * Spiff up the code for defining new graphics operators.
+    - DEFINE-GRAPHICS-OPERATOR is like DEFGENERIC.
+    - DEFINE-GRAPHICS-METHOD is like DEFMETHOD.
+    - DEFINE-GRAPHICS-RECORDING.
+    - What of this goes into the spec?
+  * Figure out what things are part of the frame manager protocol and which are
+    part of the port protocol.
+    - PORT-MENU-CHOOSE should really be FRAME-MANAGER-MENU-CHOOSE.
+    - Ditto, PORT-DIALOG-VIEW.
+  * Figure out how views really interact with frame managers and dialogs. 
+    - Indirect views. 
+  * Implement more of DRAW-DESIGN for composites.  
+    - Create a table that describes what works and what doesn't, for each port.
+  * Figure out which WINDOW-xxx functions from CLIM 1.0 make sense.  It's OK to
+    change the names to correspond to newthink.
+    - WINDOW-VIEWPORT
+    - WINDOW-VIEWPORT-POSITION* and WINDOW-SET-VIEWPORT-POSITION*.
+    - WINDOW-INSIDE-xxx and WINDOW-SET-INSIDE-xxx.
 
-% Bugs to fix.
-  * whats the problem with radio-boxes and move-cursor-after. The
-    alternative definitions almost work except for exit-buttons. I
-    think the bounding rectangle of gadget output records  is computed
-    incorrectly and that it works because the update-gadget-position
-    is broken to match.
+% Cleanups
+  * What should we retain from previous versions of CLIM?
+    - Go through CLIM 1.0 to make sure we didn't miss anything.
+    - Go through ILA CLIM with a fine-tooth comb.
+  * Flush all of the DRAW-xxx-INTERNAL junk.
+  * Find all the #+Silica/#-Silica stuff.
+    - Make sure that the #+Silica branch really does the right thing.
+    - Flush the #-Silica branch.
+  * Must we really convert all of the code to lowercase?  Do it if we must.
+  * Sort out the whole server path mechanism and make sure we can
+    windows where we want.
+
+% Bugs to fix
+  * What's the problem with radio-boxes and move-cursor-after.  The alternative
+    definitions almost work except for exit-buttons.  I think the bounding
+    rectangle of gadget output records is computed incorrectly and that it
+    works because the update-gadget-position is broken to match. 
+  * No output-recording for draw-text*. Hence the compass menu is
+    broken.
+  * why? #<standard-method stream-read-char-no-hang (motif-top-level-sheet) @ #x1b18eee>
+  * When default-text-margin slot yet bound. Drawing on a unexposed window
+    can cause problems.
+
+% Performance
+  * Meet CLIM 1.0 performance goals.
+  * Surpass CLIM 1.0 performance goals.
+  * Simplify transformation classes so that there is a single class of
+    transformation.  Special-case +IDENTITY-TRANSFORMATION+. 
+  * Make use of volatile transformations.
+    - Be careful never to modify +IDENTITY-TRANSFORMATION+.
+  * Make use of volatile rectangular regions.
+  * Reinstate sheet region and transformation caches (as in ILA CLIM).
+  * Add port-level caches for inks.
+  * (deftype coordinate () ...)
+    - Flush all inappropriate FIXNUM declarations from the code and replace them
+      with the new COORDINATE declaration.
+    - Look at callers of FLOOR, CEILING, TRUNCATE, and ROUND, and decide what of
+      those really mean to coerce to the COORDINATE type.
+    - The per-port code will needs to "devicize" all coordinates.  For example,
+      for CLX that means integerizing, but not for PostScript.
+  * Reinstate graphics function optimizers.
+    - Is any of the CLIM 1.0 graphics-defining stuff useful?
+    - Is any of the ILA CLIM graphics-defining stuff useful?
+
+% Size issues
+  * Modularize with load on demand/required modules
+    - Extended geometry (lines, ellipses, polygons).
+    - DRAW-DESIGN and MAKE-DESIGN-FROM-OUTPUT-RECORD.
+    - Some formatted output stuff: graph formatting, FILLING-OUTPUT.
 
 % Specification
-  * what happens when you draw on a sheet that is not grafted?
+  * Write up the Silica API and protocol.
+  * Write up the gadget API and protocol.
+    - Document new callback function architecture.
+  * Specify and implement DEFINE-PANE-TYPE.
+    - Implement all of the CLIM 1.0 pane types.
+  * Write up the application frame and pane API and protocol.
+    - Include the layout protocol.
+    - What about RWK's "mosaics"?
+  * Rename all of the "POSITION*" functions to "POSITION", because a "position"
+    is unambiguously an (X,Y) pair.  That is, POSITION, POSITION*, and POINT*
+    all mean the same thing. 
+    - Update the code accordingly.
+  * What happens when you draw on a sheet that is not grafted?
   * Who enables a frame?
-    - run-frame-top-level or
-    - default-frame-top-level??
-  * document new callback function architecture.
-  * Who calls realized mirror?
-  * enable-mirror and enable->mirror, mirror->enable?
-  * sheet-region/transformation can change for two reasons: program
-    does a setf or the port sends a configure notify. Should we use
-    that :port-trigger keyword in the notification protocol?
+    - RUN-FRAME-TOP-LEVEL?
+    - or DEFAULT-FRAME-TOP-LEVEL?
+    - The "command loop" proposal needs to explicitly address this.
+  * Who calls REALIZE-MIRROR?
+  * ENABLE-MIRROR and ENABLE->MIRROR, MIRROR->ENABLE?
+  * SHEET-REGION/TRANSFORMATION can change for two reasons: program does a SETF
+    or the port sends a configure notify.  Should we use that :PORT-TRIGGER
+    keyword in the notification protocol? 
+  * Enumerate the implicit inputs to all functions.
+    - *APPLICATION-FRAME*
+    - *INPUT-CONTEXT* and *NULL-PRESENTATION*
+    - *COMMAND-PARSER*, *COMMAND-UNPARSER*, and *PARTIAL-COMMAND-PARSER*
+    - *UNSUPPLIED-ARGUMENT-MARKER* and *NUMERIC-ARGUMENT-MARKER*
+    - *NUMERIC-ARGUMENT*
+    - *DELIMITER-GESTURES* and *ACTIVATION-GESTURES*
+    - *COMPLETION-GESTURES*, *HELP-GESTURES*, and *POSSIBILITIES-GESTURES*
+    - *ABORT-GESTURES* and *ACCELERATOR-GESTURES*
+    - *INPUT-WAIT-TEST* and *INPUT-WAIT-HANDLER*
+    - *POINTER-BUTTON-PRESS-HANDLER*
+    - *DEFAULT-TEXT-STYLE*, *NULL-TEXT-STYLE*, and *UNDEFINED-TEXT-STYLE*
+  * Unify the sheet and output record protocols by giving the same name to
+    generic functions that (conceptually) do the same thing.  This could lay the
+    groundwork for tighter unification later, and costs us very little.
+    - SHEET-ADOPT-CHILD and ADD-OUTPUT-RECORD
+    - SHEET-DISOWN-CHILD and DELETE-OUTPUT-RECORD
+    - SHEET-PARENT and OUTPUT-RECORD-PARENT
+    - SHEET-CHILDREN and OUTPUT-RECORD-CHILDREN
+    - The mapping functions.
+    - SHEET-REGION and BOUNDING-RECTANGLE*
+    - What else?
+
+% User Guide.
 
-% User Guide
 % Demos and example code.
-% Franz specific stuff
+
+% Franz specific stuff.
+
 % [todo: /vapor/usr/tech/cer/todo/franz-clim.todo]
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 650a70f84bf45217a42fffd35fdd7e28e756b55e..6a136c38ca8707f49fc9d9062dc8221d1b4419ab 100644
--- a/test/test-suite.lisp
+++ b/test/test-suite.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Syntax: Common-Lisp; Base: 10; Package: CLIM-USER; Mode: LISP; Lowercase: T -*-
 
-;; $fiHeader: test-suite.lisp,v 1.7 92/01/31 14:59:04 cer Exp Locker: cer $
+;; $fiHeader: test-suite.lisp,v 1.8 92/02/05 21:45:54 cer Exp Locker: cer $
 
 (in-package :clim-user)
 
@@ -1601,7 +1601,7 @@ Luke Luck licks the lakes Luke's duck likes."))
 	(draw-\\-diagonal t)
 	(line-thickness 1)
 	(line-thickness-units :normal))
-    (accepting-values (stream)
+    (accepting-values (stream :own-window t)
       (setq square-dimension
 	    (accept 'number :stream stream
 		    :prompt "Size of square" :default square-dimension))
diff --git a/test/test.lisp b/test/test.lisp
index 88867b43d6d731b7272192e78c542f587eb98b02..ca0dbd003a98810875d9d6c6ec4812e8deb66c3d 100644
--- a/test/test.lisp
+++ b/test/test.lisp
@@ -224,7 +224,7 @@
      (letf-globally (((stream-default-view stream)
 		      (if textual-view 
 			  +textual-dialog-view+
-			+gadget-dialog-view+)))
+			(stream-default-view stream))))
      (setq a (accept 'boolean  
 		     :stream stream
 		     :default a
@@ -246,6 +246,7 @@
 		     :prompt "d"
 		     :default d))
      (terpri stream)
+     #+ignore
      (accept-values-command-button (stream)
 				   "Press me"
 				   (setq a t b nil c :normal))))
diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp
index a2c59b707a2dbd5b2cc15ecf1f3934375fa24f1b..ffc2d20a0b826f3584554e364c187f5fac086c03 100644
--- a/tk-silica/ol-gadgets.lisp
+++ b/tk-silica/ol-gadgets.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-gadgets.lisp,v 1.2 92/01/31 14:56:15 cer Exp Locker: cer $
+;; $fiHeader: ol-gadgets.lisp,v 1.3 92/02/05 21:45:22 cer Exp Locker: cer $
 
 
 (in-package :xm-silica)
@@ -59,7 +59,9 @@
 			   silica::scrollbar)
 	  ())
 
-(defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port)
+(defmethod find-widget-class-and-initargs-for-sheet ((port
+						      openlook-port)
+						     (parent t)
 						     (sheet openlook-scrollbar))
   (with-accessors ((orientation silica::gadget-orientation)) sheet
 		  (values 'tk::scrollbar
@@ -158,6 +160,11 @@
 		    'sheet-mirror-resized-callback
 		    sheet))
 
+(warn "This is really bogus")
+
+(defmethod stream-read-char-no-hang ((x openlook-top-level-sheet))
+  nil)
+
 (defmethod allocate-space ((sheet openlook-top-level-sheet) width height)
   (silica::resize-sheet*  (car (sheet-children sheet)) 
 			  width height))
@@ -165,7 +172,9 @@
 (defmethod compose-space ((sheet openlook-top-level-sheet) &key width height)
   (compose-space (car (sheet-children sheet))))
 
-(defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port)
+(defmethod find-widget-class-and-initargs-for-sheet ((port
+						      openlook-port)
+						     (parent t)
 						     (sheet openlook-top-level-sheet))
   (values 'tk::draw-area
 	  (list :layout :ignore)))
@@ -201,7 +210,9 @@
    vp))
 
 
-(defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port) (sheet ol-viewport))
+(defmethod find-widget-class-and-initargs-for-sheet ((port
+						      openlook-port)
+						     (parent t)(sheet ol-viewport))
   (values 'tk::draw-area
 	  '(:layout :ignore)))
 
@@ -237,3 +248,57 @@
 ;			 'sheet-mirror-event-handler
 ;			 sheet)
   )
+
+(defclass openlook-menu-bar (xt-leaf-pane) 
+	  ((command-table :initarg :command-table)))
+
+(defmethod find-widget-class-and-initargs-for-sheet (port
+						     (parent t)
+						     (sheet openlook-menu-bar))
+  (values 'tk::control nil))
+
+(defmethod realize-mirror :around ((port openlook-port) (sheet openlook-menu-bar))
+
+  ;; This code fills the menu-bar. If top level items do not have
+  ;; submenus then it creates one with a menu of its own
+  
+  (let ((mirror (call-next-method)))
+    (labels ((make-menu-for-command-table (command-table parent top)
+	       (map-over-command-table-menu-items
+		#'(lambda (menu keystroke item)
+		    (declare (ignore keystroke))
+		    (let ((type (command-menu-item-type item)))
+		      (case type
+			(:divider)
+			(:function
+			 ;;--- Do this sometime
+			 )
+			(:menu
+			 (let* ((mb (make-instance 'tk::menu-button
+						  :parent parent
+						  :label menu)))
+			   (make-menu-for-command-table
+			    (find-command-table (second item))
+			    (tk::get-values mb :menu-pane)
+			    nil)))
+			(t
+			 (let ((button 
+				(make-instance 'tk::oblong-button
+					       :label menu
+					       :managed t
+					       :parent parent)))
+			   (tk::add-callback
+			    button
+			    :select
+			    'command-button-callback-ol
+			    (slot-value sheet 'silica::frame)
+			    item))))))
+		command-table)))
+      (make-menu-for-command-table
+       (slot-value sheet 'command-table)
+       mirror
+       t))
+    mirror))
+
+(defun command-button-callback-ol (button frame item)
+  (command-button-callback button nil frame item))
diff --git a/tk-silica/ol-silica.lisp b/tk-silica/ol-silica.lisp
index 4aa550d019622c88845da18d6d4c87a460346a50..d942a1cd635cb974ff72bef6f807692548968960 100644
--- a/tk-silica/ol-silica.lisp
+++ b/tk-silica/ol-silica.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-silica.lisp,v 1.2 92/01/31 14:56:19 cer Exp Locker: cer $
+;; $fiHeader: ol-silica.lisp,v 1.3 92/02/05 21:45:23 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -30,6 +30,9 @@
 (defmethod find-port-type ((type (eql :openlook)))
   'openlook-port)
 
+(warn "Changing the default server path to ~S"
+      (setq silica::*default-server-path* '(:openlook :display "localhost:0")))
+
 (defmethod port-note-cursor-change ((port openlook-port)
 				    cursor
 				    stream
diff --git a/tk-silica/xm-frames.lisp b/tk-silica/xm-frames.lisp
index 6514b103eb5825a2c942c2f045e77bfed7fd2d42..067713e8b9da1887e021754e6957d8dc2741b851 100644
--- a/tk-silica/xm-frames.lisp
+++ b/tk-silica/xm-frames.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-frames.lisp,v 1.6 92/01/31 14:56:27 cer Exp Locker: cer $
+;; $fiHeader: xm-frames.lisp,v 1.7 92/02/05 21:45:25 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -144,22 +144,14 @@
 
 
 
-(defmethod clim-internals::frame-wrapper ((frame t) (framem motif-frame-manager) pane)
-  (let ((mb (slot-value frame 'clim-internals::menu-bar)))
-    (if mb
-	(with-look-and-feel-realization (framem frame)
-	  (vertically ()
-		      (realize-pane 'menu-bar
-				    :command-table (if (eq mb t)
-						       (frame-command-table frame)
-						     (find-command-table mb)))
-		      (call-next-method)))
-      (call-next-method))))
+
 
 (defclass motif-menu-bar (xt-leaf-pane) 
 	  ((command-table :initarg :command-table)))
 
-(defmethod find-widget-class-and-initargs-for-sheet (port (sheet motif-menu-bar))
+(defmethod find-widget-class-and-initargs-for-sheet (port
+						     (parent t)
+						     (sheet motif-menu-bar))
   (values 'tk::xm-menu-bar 
 	  (list :resize-height t
 		:resize-width t)))
@@ -227,29 +219,7 @@
        t))
     mirror))
 
-(defclass presentation-event (event)
-	  ((value :initarg :value :reader presentation-event-value)
-	   (sheet :initarg :sheet :reader event-sheet)))
-
-(defmethod handle-event (sheet (event presentation-event))
-  (throw-highlighted-presentation
-   (make-instance 'standard-presentation
-		  :object (presentation-event-value event)
-		  :type 'command)
-   *input-context*
-   (make-instance 'pointer-button-press-event
-		  :sheet sheet
-		  :x 0
-		  :y 0
-		  :modifiers 0
-		  :button 256)))
 
-(defun command-button-callback (button dunno frame item)
-  (distribute-event
-   (sheet-port frame)
-   (make-instance 'presentation-event
-		  :sheet (frame-top-level-sheet frame)
-		  :value (second item))))
 
 (defmethod port-dialog-view ((port motif-port))
   +gadget-dialog-view+)
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index ccf9f1693424d53ae5e669319e8ef64bda5b59a8..ed92fc30605c215778ff18a2c44b49c2c4abedf4 100644
--- a/tk-silica/xm-gadgets.lisp
+++ b/tk-silica/xm-gadgets.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-gadgets.lisp,v 1.8 92/02/05 21:45:26 cer Exp Locker: cer $
+;; $fiHeader: xm-gadgets.lisp,v 1.9 92/02/08 14:51:40 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -105,7 +105,9 @@
 
 
 
-(defmethod find-widget-class-and-initargs-for-sheet (port (sheet motif-push-button))
+(defmethod find-widget-class-and-initargs-for-sheet (port
+						     (parent t)
+						     (sheet motif-push-button))
   (declare (ignore port))
   (with-accessors ((label silica::gadget-label)) sheet
     (values 'tk::xm-push-button 
@@ -146,6 +148,7 @@
 	  ())
 
 (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
+						     (parent t)
 						     (sheet motif-drawing-area))
   (values 'tk::xm-drawing-area (list :margin-width 0 
 				     :resize-policy :none
@@ -163,7 +166,9 @@
 	  ())
 
 
-(defmethod find-widget-class-and-initargs-for-sheet ((port motif-port) (sheet motif-slider))
+(defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
+						     (parent t)
+						     (sheet motif-slider))
   (with-accessors ((orientation silica::gadget-orientation)
 		   (label silica::gadget-label)
 		   (value gadget-value)) sheet
@@ -200,6 +205,7 @@
 	  ())
 
 (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
+						     (parent t)
 						     (sheet motif-scrollbar))
   (with-accessors ((orientation silica::gadget-orientation)) sheet
 		  (values 'tk::xm-scroll-bar 
@@ -279,31 +285,8 @@
 
 (defmethod add-sheet-callbacks :after ((port motif-port) 
 				       (sheet motif-top-level-sheet)
-				       widget)
-
-;  (tk::add-callback widget 
-;		    :expose-callback 
-;		    'sheet-mirror-exposed-callback
-;		    sheet)
-;  (tk::add-callback widget 
-;		    :input-callback 
-;		    'sheet-mirror-input-callback
-;		    sheet)
-;  (tk::add-event-handler widget
-;			 '(:enter-window 
-;			   :leave-window
-;			   :pointer-motion-hint
-;			   :pointer-motion
-;			   :button1-motion
-;			   :button2-motion
-;			   :button3-motion
-;			   :button4-motion
-;			   :button5-motion
-;			   :button-motion
-;			   )
-;			 0
-;			 'sheet-mirror-event-handler
-;			 sheet)
+				       (widget tk::xm-drawing-area))
+
   (tk::add-callback widget 
 		    :resize-callback 
 		    'sheet-mirror-resized-callback
@@ -315,14 +298,51 @@
 
 (defmethod compose-space ((sheet motif-top-level-sheet) &key width height)
   (compose-space (car (sheet-children sheet)) :width width :height height))
+;;;-- Test whether this is a dialog box or 
 
-(defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
-						     (sheet motif-top-level-sheet))
-  (values 'tk::xm-drawing-area 
-	  (list :resize-policy :none
-		:margin-width 0 :margin-height 0)))
 
 
+(defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
+						     (parent t)
+						     (sheet
+						      motif-top-level-sheet))
+  (cond 
+   ;;--- hack alert
+   ;; Seems that we need to use a bulletin board so that everything
+   ;; comes up in the right place.
+   ((popup-frame-p sheet)
+    (values 'tk::xm-bulletin-board
+	    nil))
+   (t
+    (values 'tk::xm-drawing-area 
+	    (list :resize-policy :none
+		  :margin-width 0 :margin-height 0)))))
+
+;;; 
+
+(defmethod add-sheet-callbacks :after ((port motif-port) (sheet t) (widget tk::xm-bulletin-board))
+  (tk::add-event-handler widget
+			 '(:enter-window 
+			   :leave-window
+			   :pointer-motion-hint
+			   :pointer-motion
+			   :button1-motion
+			   :button2-motion
+			   :button3-motion
+			   :button4-motion
+			   :button5-motion
+			   :button-motion
+			   :exposure
+			   :structure-notify
+			   :key-press
+			   :key-release
+			   :button-press
+			   :button-release
+      			   )
+			 0
+			 'sheet-mirror-event-handler
+			 sheet))
+
 ;;;; text field
 
 (defclass motif-text-field (xt-leaf-pane
@@ -331,6 +351,7 @@
 	  ())
 
 (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
+						     (parent t)
 						     (sheet motif-text-field))
   (with-accessors ((value gadget-value)) sheet
     (values 'tk::xm-text-field 
@@ -346,6 +367,7 @@
 	  ())
 
 (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
+						     (parent t)
 						     (sheet motif-toggle-button))
   (with-accessors ((set gadget-value)
 		   (label silica::gadget-label)
@@ -369,32 +391,8 @@
 
 (defmethod xm-silica::add-sheet-callbacks :after ((port motif-port) 
 						  (sheet clim-internals::extended-stream-sheet)
-						  (widget t))
-  (declare (ignore sheet))
-;  (tk::add-callback widget 
-;		    :expose-callback 
-;		    'sheet-mirror-exposed-callback
-;		    sheet)
-;  (tk::add-callback widget 
-;		    :input-callback 
-;		    'sheet-mirror-input-callback
-;		    sheet)
-;  (tk::add-event-handler widget
-;			 '(:enter-window 
-;			   :leave-window
-;			   :pointer-motion-hint
-;			   :pointer-motion
-;			   :button1-motion
-;			   :button2-motion
-;			   :button3-motion
-;			   :button4-motion
-;			   :button5-motion
-;			   :button-motion
-;			   )
-;			 0
-;			 'sheet-mirror-event-handler
-;			 sheet)
-  ;; It would suprise me if we needed this.
+						  (widget tk::xm-drawing-area))
+  ;;---- It would suprise me if we needed this.
   (tk::add-callback widget 
 		    :resize-callback 
 		    'sheet-mirror-resized-callback
@@ -463,45 +461,25 @@
    vp))
 
 
-(defmethod find-widget-class-and-initargs-for-sheet ((port motif-port) (sheet xm-viewport))
+(defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
+						     (parent t)
+						     (sheet xm-viewport))
   (values 'tk::xm-drawing-area
 	  '(:scrolling-policy :application-defined
 	    :margin-width 0 :margin-height 0
 	    :resize-policy :none
 	    :scroll-bar-display-policy :static)))
 
-(defmethod add-sheet-callbacks  :after ((port motif-port) (sheet xm-viewport) widget)
-  ;; I wonder whether this is needed since it should not be resized by
+(defmethod add-sheet-callbacks  :after ((port motif-port) 
+					(sheet xm-viewport)
+					(widget tk::xm-drawing-area))
+  ;;--- I wonder whether this is needed since it should not be resized by
   ;; the toolkit and only as part of the goe management code that will
   ;; recurse to children anyway
   (tk::add-callback widget 
 		    :resize-callback 
 		    'sheet-mirror-resized-callback
-		    sheet)
-;  (tk::add-callback widget 
-;		    :expose-callback 
-;		    'sheet-mirror-exposed-callback
-;		    sheet)
-;  (tk::add-callback widget 
-;		    :input-callback 
-;		    'sheet-mirror-input-callback
-;		    sheet)
-;  (tk::add-event-handler widget
-;			 '(:enter-window 
-;			   :leave-window
-;			   :pointer-motion-hint
-;			   :pointer-motion
-;			   :button1-motion
-;			   :button2-motion
-;			   :button3-motion
-;			   :button4-motion
-;			   :button5-motion
-;			   :button-motion
-;			   )
-;			 0
-;			 'sheet-mirror-event-handler
-;			 sheet)
-  )
+		    sheet))
 
 (defclass  motif-radio-box (motif-geometry-manager
 			    mirrored-sheet-mixin
@@ -516,6 +494,7 @@
   (setf (gadget-client child) gadget))
 
 (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
+						     (parent t)
 						     (sheet motif-radio-box))
   
   (with-accessors ((orientation silica::gadget-orientation)) sheet
@@ -544,6 +523,7 @@
 	  ())
 
 (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
+						     (parent t)
 						     (sheet motif-frame-pane))
   (values 'tk::xm-frame nil))
 	  
diff --git a/tk-silica/xm-silica.lisp b/tk-silica/xm-silica.lisp
index 796c6407500433c476b3484deafd18fcf6a2f045..39e1988902d912297f8570ade0a9c2223a91b4e9 100644
--- a/tk-silica/xm-silica.lisp
+++ b/tk-silica/xm-silica.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-silica.lisp,v 1.6 92/01/31 14:56:35 cer Exp Locker: cer $
+;; $fiHeader: xm-silica.lisp,v 1.7 92/02/08 14:51:41 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -50,18 +50,25 @@
   (setf (silica::port-keyboard-focus port) 
     (and new stream)))
 
-
-(defmethod change-widget-geometry (parent child &rest args)
-  (declare (ignore parent))
-  ;; In this case let the parent deal with it
-  (apply #'tk::set-values child args))
-		 
 (defmethod change-widget-geometry ((parent tk::xm-drawing-area) child
 				   &rest args
 				   &key x y width height)
   (declare (ignore x y width height))
   (apply #'tk::configure-widget child args))
 
+(defmethod change-widget-geometry ((parent tk::xm-bulletin-board) child
+				   &rest args
+				   &key x y width height)
+  (declare (ignore x y width height))
+  (apply #'tk::configure-widget child args))
+
+(defmethod change-widget-geometry ((parent tk::shell) child
+				   &rest args
+				   &key x y width height)
+  (declare (ignore x y args))
+  ;;-- shells decide where windows are positioned!
+  (tk::set-values child :width width :height height))
+
 (defclass motif-geometry-manager ()
 	  ;; --- This is probably all
 	  ;; composites excepts drawing-area and shell
@@ -95,3 +102,15 @@ about their children"))
 (defmethod update-geo-manager-sheet-children (geo-manager)
   (dolist (child (sheet-children geo-manager))
     (mirror-region-updated (sheet-port geo-manager) child)))
+
+(defmethod find-shell-class-and-initargs ((port motif-port) sheet)
+  (declare (ignore port))
+  (cond ( ;;--- hack alert
+	 (popup-frame-p sheet)
+	 (values 'xm-dialog-shell
+		 (append
+		  (let ((x (find-shell-of-calling-frame sheet)))
+		    (and x `(:transient-for ,x)))
+		  '(:keyboard-focus-policy :pointer))))
+	(t
+	 (call-next-method))))
diff --git a/tk-silica/xt-frames.lisp b/tk-silica/xt-frames.lisp
index a634e6c5c66a8f78ec6cda3ce2680c26f051ab62..e530c1d5b9c24b70418de34203bd66b4231546c4 100644
--- a/tk-silica/xt-frames.lisp
+++ b/tk-silica/xt-frames.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-frames.cl,v 1.1 92/01/17 17:48:17 cer Exp $
+;; $fiHeader: xt-frames.lisp,v 1.2 92/01/31 14:56:37 cer Exp Locker: cer $
 
 
 (in-package :xm-silica)
@@ -51,3 +51,43 @@
       (setf (frame-top-level-sheet frame) sheet
 	    (frame-shell frame) (sheet-shell sheet))
       (sheet-adopt-child sheet (frame-panes frame)))))
+
+
+(defmethod clim-internals::frame-wrapper ((frame t) (framem xt-frame-manager) pane)
+  (declare (ignore pane))
+  (let ((mb (slot-value frame 'clim-internals::menu-bar)))
+    (if mb
+	(with-look-and-feel-realization (framem frame)
+	  (vertically ()
+		      (realize-pane 'menu-bar
+				    :command-table (if (eq mb t)
+						       (frame-command-table frame)
+						     (find-command-table mb)))
+		      (call-next-method)))
+      (call-next-method))))
+
+;;; 
+
+(defclass presentation-event (event)
+	  ((value :initarg :value :reader presentation-event-value)
+	   (sheet :initarg :sheet :reader event-sheet)))
+
+(defmethod handle-event (sheet (event presentation-event))
+  (throw-highlighted-presentation
+   (make-instance 'standard-presentation
+		  :object (presentation-event-value event)
+		  :type 'command)
+   *input-context*
+   (make-instance 'pointer-button-press-event
+		  :sheet sheet
+		  :x 0
+		  :y 0
+		  :modifiers 0
+		  :button 256)))
+
+(defun command-button-callback (button dunno frame item)
+  (distribute-event
+   (sheet-port frame)
+   (make-instance 'presentation-event
+		  :sheet (frame-top-level-sheet frame)
+		  :value (second item))))
diff --git a/tk-silica/xt-gadgets.lisp b/tk-silica/xt-gadgets.lisp
index e664091cbb57f7b8d405daf6e4ce807a45c4e332..0e1433586851cc3fba1b78f29db88e3aba323f27 100644
--- a/tk-silica/xt-gadgets.lisp
+++ b/tk-silica/xt-gadgets.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-gadgets.lisp,v 1.2 92/01/31 14:56:38 cer Exp Locker: cer $
+;; $fiHeader: xt-gadgets.lisp,v 1.3 92/02/05 21:45:29 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -58,6 +58,7 @@
 (defmethod find-widget-class-and-initargs-for-sheet 
     :around
     ((port xt-port)
+     (parent t)
      (sheet 
       silica::foreground-background-and-text-style-mixin))
   (multiple-value-bind
@@ -135,6 +136,7 @@
 
 (defun clim-internals::scroll-extent (stream &key (x 0) (y 0))
   (let ((vp (clim-internals::pane-viewport stream)))
+    (when vp
     (with-bounding-rectangle* (left top right bottom) 
                               (clim-internals::pane-viewport-region stream)
       ;;;---- This should actually bash the sheet-transformation
@@ -180,7 +182,7 @@
 	  (replay
 	   (stream-output-history stream)
 	   stream
-	   (silica::xm-viewport-viewport vp))))))))
+	   (silica::xm-viewport-viewport vp)))))))))
 
 (defclass xt-pane (silica::pane) ())
 
diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp
index 200eca3968e43f15a03184b302d262d1be4da8fb..e6f339e8a9e6e96bc101a10832e6fa46bcd7c7af 100644
--- a/tk-silica/xt-graphics.lisp
+++ b/tk-silica/xt-graphics.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-graphics.lisp,v 1.4 92/01/31 16:22:09 cer Exp Locker: cer $
+;; $fiHeader: xt-graphics.lisp,v 1.5 92/02/05 21:45:30 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -542,7 +542,7 @@
 	       (width (- from-right from-left))
 	       (height (- from-bottom from-top))
 	       (copy-gc (port-copy-gc port)))
-	  (when (and from-medium to-medium)
+	  (when (and from-window to-window)
 	    (tk::copy-area 
 	     from-window
 	     copy-gc from-left from-top width height to-window to-left to-top)))))))
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index f1e3b2e521cfe74bc6b6716ff6925a1becc4cef2..907b5817a52e1c72440c04c2dd32876d36c11f02 100644
--- a/tk-silica/xt-silica.lisp
+++ b/tk-silica/xt-silica.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-silica.lisp,v 1.4 92/02/05 21:45:32 cer Exp Locker: cer $
+;; $fiHeader: xt-silica.lisp,v 1.5 92/02/08 14:51:43 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -165,15 +165,16 @@
   (tk::destroy-widget (sheet-direct-mirror sheet)))
 
 (defmethod realize-mirror ((port xt-port) sheet)
-  (multiple-value-bind
-      (class initargs)
-      (find-widget-class-and-initargs-for-sheet port sheet)
-    (let ((widget (apply #'make-instance class
-			 :parent (find-widget-parent port sheet)
-			 :managed (sheet-enabled-p sheet)
-			 initargs)))
-      (add-sheet-callbacks port sheet widget)
-      widget)))
+  (let ((parent (find-widget-parent port sheet)))
+    (multiple-value-bind
+	(class initargs)
+	(find-widget-class-and-initargs-for-sheet port parent sheet)
+      (let ((widget (apply #'make-instance class
+			   :parent parent
+			   :managed (sheet-enabled-p sheet)
+			   initargs)))
+	(add-sheet-callbacks port sheet widget)
+	widget))))
 
 (defmethod add-sheet-callbacks ((port xt-port) sheet (widget t))
   (declare (ignore sheet)))
@@ -185,74 +186,90 @@
     (declare (ignore same-p root child root-x root-y))
     (let ((modifiers (logand #16rff mask))
 	  (button (ash mask -8)))
-      (distribute-event
-       (sheet-port sheet)
-       (ecase (tk::event-type event)
-	 (:key-press
-	  (multiple-value-bind
-	       (ignore character keysym)
-	       (tk::lookup-string event)
-	     (declare (ignore ignore))
-	     (make-instance 'key-press-event
-			    :key-name keysym
-			    :character (and (= (length character) 1)
-					    (aref character 0))
-			    :sheet sheet
-			    :modifiers (x11::xkeyevent-state event))))
+      (let ((clim-event
+	     (ecase (tk::event-type event)
+	       ((:map-notify :unmap-notify)
+		nil)
+	       (:configure-notify
+		(sheet-mirror-resized-callback
+		 widget nil event sheet)
+		nil)
+	       (:expose
+		(sheet-mirror-exposed-callback
+		 widget 
+		 nil ; window
+		 event
+		 sheet)
+		nil)
+	       (:key-press
+		(multiple-value-bind
+		    (ignore character keysym)
+		    (tk::lookup-string event)
+		  (declare (ignore ignore))
+		  (make-instance 'key-press-event
+				 :key-name keysym
+				 :character (and (= (length character) 1)
+						 (aref character 0))
+				 :sheet sheet
+				 :modifiers (x11::xkeyevent-state event))))
     
-	 (:key-release
-	  (multiple-value-bind
-	       (ignore character keysym)
-	       (tk::lookup-string event)
-	     (declare (ignore ignore))
-	     (make-instance 'key-release-event
-			    :key-name keysym
-			    :character (and (= (length character) 1)
-					    (aref character 0))
-			    :sheet sheet
-			    :modifiers (x11::xkeyevent-state event))))
+	       (:key-release
+		(multiple-value-bind
+		    (ignore character keysym)
+		    (tk::lookup-string event)
+		  (declare (ignore ignore))
+		  (make-instance 'key-release-event
+				 :key-name keysym
+				 :character (and (= (length character) 1)
+						 (aref character 0))
+				 :sheet sheet
+				 :modifiers (x11::xkeyevent-state event))))
     
-	 (:button-press
-	  (make-instance 'pointer-button-press-event
-			  :sheet sheet
-			  :x :??
-			  :y :??
-			  :modifiers (x11::xkeyevent-state event)
-			  :button (x-button->silica-button 
-				   (x11::xbuttonevent-button event))
-			  :native-x (x11::xbuttonevent-x event)
-			  :native-y (x11::xbuttonevent-y event)))
-	 (:button-release
-	  (make-instance 'pointer-button-release-event
-			  :sheet sheet
-			  :x :??
-			  :y :??
-			  :modifiers (x11::xkeyevent-state event)
-			  :button (x-button->silica-button 
-				   (x11::xbuttonevent-button event))
-			  :native-x (x11::xbuttonevent-x event)
-			  :native-y (x11::xbuttonevent-y event)))
-	 (:leave-notify
-	  (make-instance 'pointer-exit-event
-			 :native-x native-x
-			 :native-y native-y
-			 :button (x-button->silica-button button)
-			 :modifiers modifiers
-			 :sheet sheet))
-	 (:enter-notify
-	  (make-instance 'pointer-enter-event
-			 :native-x native-x
-			 :native-y native-y
-			 :button (x-button->silica-button button)
-			 :modifiers modifiers
-			 :sheet sheet))
-	 (:motion-notify
-	  (make-instance 'pointer-motion-event
-			 :native-x native-x
-			 :native-y native-y
-			 :button (x-button->silica-button button)
-			 :modifiers modifiers
-			 :sheet sheet)))))))
+	       (:button-press
+		(make-instance 'pointer-button-press-event
+			       :sheet sheet
+			       :x :??
+			       :y :??
+			       :modifiers (x11::xkeyevent-state event)
+			       :button (x-button->silica-button 
+					(x11::xbuttonevent-button event))
+			       :native-x (x11::xbuttonevent-x event)
+			       :native-y (x11::xbuttonevent-y event)))
+	       (:button-release
+		(make-instance 'pointer-button-release-event
+			       :sheet sheet
+			       :x :??
+			       :y :??
+			       :modifiers (x11::xkeyevent-state event)
+			       :button (x-button->silica-button 
+					(x11::xbuttonevent-button event))
+			       :native-x (x11::xbuttonevent-x event)
+			       :native-y (x11::xbuttonevent-y event)))
+	       (:leave-notify
+		(make-instance 'pointer-exit-event
+			       :native-x native-x
+			       :native-y native-y
+			       :button (x-button->silica-button button)
+			       :modifiers modifiers
+			       :sheet sheet))
+	       (:enter-notify
+		(make-instance 'pointer-enter-event
+			       :native-x native-x
+			       :native-y native-y
+			       :button (x-button->silica-button button)
+			       :modifiers modifiers
+			       :sheet sheet))
+	       (:motion-notify
+		(make-instance 'pointer-motion-event
+			       :native-x native-x
+			       :native-y native-y
+			       :button (x-button->silica-button button)
+			       :modifiers modifiers
+			       :sheet sheet)))))
+	(when clim-event
+	  (distribute-event
+	   (sheet-port sheet)
+	   clim-event))))))
 
 (defun x-button->silica-button (button)
   (ecase button
@@ -351,20 +368,24 @@
 		     :native-x (x11::xbuttonevent-x event)
 		     :native-y (x11::xbuttonevent-y event))))))
 
-(defmethod find-widget-class-and-initargs-for-sheet (port (sheet sheet))
+(defmethod find-widget-class-and-initargs-for-sheet (port
+						     (parent t)
+						     (sheet sheet))
   (declare (ignore port))
   (values 'xm-drawing-area (list :resize-policy :grow)))
 
-(defmethod find-widget-class-and-initargs-for-sheet :around (port (sheet sheet))
+(defmethod find-widget-class-and-initargs-for-sheet :around (port
+							     (parent t)
+							     (sheet sheet))
   (declare (ignore port))
   (multiple-value-bind
       (class initargs)
       (call-next-method)
-    (setq initargs (set-mirror-geometry sheet initargs))
+    (setq initargs (set-mirror-geometry parent sheet initargs))
     (values class initargs)))
 
 
-(defmethod set-mirror-geometry (sheet initargs)
+(defmethod set-mirror-geometry (parent sheet initargs)
   ;;--- Should we pass in the size of the sheet even though it is
   ;; liable to be quite stupid
   ;; We really want to just create the gadgets and then let the layout
@@ -373,9 +394,12 @@
     (multiple-value-bind
 	(left top right bottom)
 	(sheet-actual-native-edges sheet)
-      (setf (getf initargs :x) (floor left)
-	    (getf initargs :y) (floor top)
-	    (getf initargs :width) (floor (- right left))
+      ;;--- We do not want to specify the x,y if this is a top-level
+      ;;sheet.
+      (unless (typep parent 'tk::shell)
+	(setf (getf initargs :x) (floor left)
+	      (getf initargs :y) (floor top)))
+      (setf (getf initargs :width) (floor (- right left))
 	    (getf initargs :height) (floor (- bottom top)))))
   initargs)
 
@@ -389,23 +413,42 @@
 	    (class initargs)
 	    (find-shell-class-and-initargs port sheet)
 	  (apply #'make-instance class
-		 :parent (port-application-shell port)
+		 :parent (find-shell-parent port sheet)
 		 initargs))
       (sheet-mirror ma))))
 
+(defmethod find-shell-of-calling-frame ((sheet sheet))
+  (find-shell-of-calling-frame (pane-frame sheet)))
+
+(defmethod find-shell-of-calling-frame ((frame application-frame))
+  (let (cf)
+    (and (setq cf (clim-internals::frame-calling-frame frame))
+	 (sheet-shell (frame-top-level-sheet cf)))))
+
+(defmethod find-shell-parent (port sheet)
+  (or (and  ;;--- hack alert
+       (popup-frame-p sheet)
+       (find-shell-of-calling-frame sheet))
+      (port-application-shell port)))
+
+
 (defmethod find-shell-class-and-initargs (port sheet)
+  (declare (ignore port))
   (values 'top-level-shell 
 	  ;; Need this so that an interactive pane can have children
 	  ;; but still accept the focus
 	  '(:keyboard-focus-policy :pointer)))
 
+
+
+
 (defmethod enable-mirror (port sheet)
   (declare (ignore port))
   (let ((mirror (sheet-mirror sheet)))
     (typecase (widget-parent mirror)
       (null)
-      (top-level-shell
-       ;; this is a nasty hack just to make sure that the child is managed.
+      ((or top-level-shell tk::xm-dialog-shell)
+       ;;--- this is a nasty hack just to make sure that the child is managed.
        ;; top-level-sheets are created unmanaged because they are
        ;; disabled to we have to do not!
        (manage-child mirror)
@@ -476,6 +519,8 @@
 	  w (floor w)
 	  h (floor h))
     (change-widget-geometry
+     ;;--- For top level sheets the sheet-parent is the graft whose
+     ;; mirror is the application shell
      (sheet-mirror (sheet-parent sheet))
      (sheet-direct-mirror sheet)
      :x target-left
@@ -589,3 +634,15 @@
 
 (defmethod clim-internals::port-finish-output ((port xt-port))
   nil)
+
+(defmethod change-widget-geometry (parent child &rest args)
+  (declare (ignore parent))
+  ;; In this case let the parent deal with it
+  (apply #'tk::set-values child args))
+
+
+(defmethod popup-frame-p ((frame application-frame))
+  (typep frame '(or clim-internals::menu-frame clim-internals::accept-values-own-window)))
+
+(defmethod popup-frame-p ((sheet sheet))
+  (popup-frame-p (pane-frame sheet)))
diff --git a/tk/callbacks.lisp b/tk/callbacks.lisp
index 1c27f0095606c4f495697ef9391221250cabe34a..9407654aecf84741213e0ff773af7c559c9ba934 100644
--- a/tk/callbacks.lisp
+++ b/tk/callbacks.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: callbacks.cl,v 1.4 92/01/17 17:49:05 cer Exp $
+;; $fiHeader: callbacks.lisp,v 1.5 92/01/31 14:54:14 cer Exp Locker: cer $
 
 (in-package :tk)
 
@@ -127,7 +127,7 @@
 
 	    ;; OpenLook Callbacks
 	    ("sliderMoved" slider-moved)
-	    
+	    ("select")
 	    )))
 
 (defun convert-callback-name (x)
diff --git a/tk/event.lisp b/tk/event.lisp
index 4b5f0012c4454c8ae88366aa32c88425d20d2960..40bc567b44b5995ae31810e3ce505066e170107d 100644
--- a/tk/event.lisp
+++ b/tk/event.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: event.cl,v 1.2 92/01/02 15:08:38 cer Exp $
+;; $fiHeader: event.lisp,v 1.3 92/01/31 14:54:23 cer Exp Locker: cer $
 
 (in-package :tk)
 
@@ -35,6 +35,11 @@
   (loop 
       (process-one-event context)))
 
+(defconstant *xt-im-xevent*		1)
+(defconstant *xt-im-timer*		2)
+(defconstant *xt-im-alternate-input*	4)
+(defconstant *xt-im-all* (logior *xt-im-xevent*  *xt-im-timer*  *xt-im-alternate-input*))
+
 (defun process-one-event (context &key timeout wait-function)
   (let (mask
 	(fds (mapcar #'(lambda (display)
@@ -59,7 +64,11 @@
 			#'wait-function))))
       (mapc #'multiprocessing::mpunwatchfor fds))
     (cond ((plusp mask)
-	   (app-process-event context mask)
+	   (app-process-event 
+	    context 
+	    ;; Because of a feature in the OLIT toolkit we need to
+	    ;; give preference to events rather than timer events
+	    (if (logtest mask *xt-im-xevent*) *xt-im-xevent* mask))
 	   t)
 	  (reason :wait-function)
 	  (t :timeout))))