diff --git a/Makefile b/Makefile
index ff93d378146d8e4f1b5d0fd9d59c19a60b4d0da2..20fadb8715e641d8efd5dd4783609f24d0fd21cf 100644
--- a/Makefile
+++ b/Makefile
@@ -1,8 +1,8 @@
-# $fiHeader: Makefile,v 1.16 92/03/10 10:13:11 cer Exp Locker: cer $
+# $fiHeader: Makefile,v 1.17 92/03/10 16:00:50 cer Exp Locker: cer $
 # 
 #  Makefile for CLIM 2.0
 #
-CL	= /net/sparky/usr/tech/jdi/4.1/src/dcl
+CL	= /vapor/usr/tech/cer/cl/src/dcl
 DUMP-CL	= $(CL)
 CLOPTS	= -qq
 
@@ -23,7 +23,7 @@ DEVICE	= /dev/null
 RM	= /bin/rm
 CAT	= /bin/cat
 ECHO	= /bin/echo
-MV	= mv
+MV	= mv-nfs
 TAGS	= /usr/fi/lib/emacs/etc/etags
 TMP	= /usr/tmp
 
@@ -131,7 +131,7 @@ CLIM-STANDALONE-OBJS = clim/gestures.fasl \
 
 XLIB-CLIM-OBJS = xlib/pkg.fasl
 
-XT-CLIM-OBJS = tk/pkg.fasl \
+XT-TK-OBJS = tk/pkg.fasl \
                 tk/foreign-obj.fasl \
                 tk/macros.fasl \
                 tk/xlib.fasl \
@@ -149,7 +149,7 @@ XT-CLIM-OBJS = tk/pkg.fasl \
                 tk/xt-classes.fasl \
                 tk/xt-init.fasl
 
-XM-CLIM-OBJS = tk/xm-classes.fasl \
+XM-TK-OBJS = tk/xm-classes.fasl \
                 tk/xm-init.fasl \
                 tk/xm-widgets.fasl \
                 tk/xm-font-list.fasl \
@@ -157,6 +157,11 @@ XM-CLIM-OBJS = tk/xm-classes.fasl \
                 tk/convenience.fasl \
                 tk/make-widget.fasl
 
+OL-CLIM-OBJS = tk/ol-classes.fasl \
+                tk/ol-init.fasl \
+                tk/ol-callbacks.fasl \
+                tk/make-widget.fasl
+
 MOTIF-CLIM-OBJS = xm-silica/pkg.fasl \
                    xm-silica/xt-silica.fasl \
                    xm-silica/xm-silica.fasl \
@@ -171,10 +176,6 @@ MOTIF-CLIM-OBJS = xm-silica/pkg.fasl \
                    xm-silica/xt-pixmaps.fasl \
                    xm-silica/xm-cursor.fasl
 
-OL-CLIM-OBJS = tk/ol-classes.fasl \
-                tk/ol-init.fasl \
-                tk/ol-callbacks.fasl \
-                tk/make-widget.fasl
 
 OPENLOOK-CLIM-OBJS = xm-silica/pkg.fasl \
                       xm-silica/xt-silica.fasl \
@@ -188,30 +189,54 @@ OPENLOOK-CLIM-OBJS = xm-silica/pkg.fasl \
                       xm-silica/ol-gadgets.fasl \
                       xm-silica/xt-pixmaps.fasl
 
-MOTIF-OBJS = $(CLIM-UTILS-OBJS) $(CLIM-SILICA-OBJS) $(CLIM-STANDALONE-OBJS) \
-	     $(XLIB-CLIM-OBJS) $(XT-CLIM-OBJS) $(XM-CLIM-OBJS) \
-	     $(MOTIF-CLIM-OBJS) 
+GENERIC-OBJS= $(CLIM-UTILS-OBJS) $(CLIM-SILICA-OBJS) $(CLIM-STANDALONE-OBJS)
+XT-OBJS= $(XLIB-CLIM-OBJS) $(XT-TK-OBJS)
+MOTIF-OBJS =  $(XM-TK-OBJS) $(MOTIF-CLIM-OBJS) 
+OPENLOOK-OBJS = #(OL-CLIM-OBJS) $(OPENLOOK-CLIM-OBJS)
 
-OPENLOOK-OBJS = $(CLIM-UTILS-OBJS) $(CLIM-SILICA-OBJS) \
-		$(CLIM-STANDALONE-OBJS) $(XLIB-CLIM-OBJS) $(XT-CLIM-OBJS) \
-		$(OL-CLIM-OBJS) $(OPENLOOK-CLIM-OBJS)
+default: all-xm
 
-default: compile clim
+all-xm:	compile-xm cat-xm clim-xm
+all-ol:	compile-ol cat-ol clim-ol
 
-all:	compile cat clim
+# Compilation
 
-compile:	FORCE
+compile-xm:	FORCE
 	$(ECHO) " \
 		(setq *ignore-package-name-case* t) \
 		(set-case-mode :case-insensitive-lower) \
 		(proclaim '(optimize (speed $(SPEED)) (safety $(SAFETY)))) \
 		(load \"misc/compile-xm.lisp\")" | $(CL) $(CLOPTS) -batch
 
-clim.fasl:	$(MOTIF-OBJS)
-	$(CAT) $(MOTIF-OBJS) > $(TMP)/clim.fasl_`whoami`
-	$(MV) $(TMP)/clim.fasl_`whoami` clim.fasl
-	ls -lt clim.fasl >> Clim-sizes.n
-	ls -lt clim.fasl
+compile-ol:	FORCE
+	$(ECHO) " \
+		(setq *ignore-package-name-case* t) \
+		(set-case-mode :case-insensitive-lower) \
+		(proclaim '(optimize (speed $(SPEED)) (safety $(SAFETY)))) \
+		(load \"misc/compile-ol.lisp\")" | $(CL) $(CLOPTS) -batch
+
+# Concatenation
+
+cat-xm:	climg.fasl climxm.fasl clim-debug.fasl
+cat-ol:	climg.fasl climol.fasl clim-debug.fasl
+
+climg.fasl	: $(GENERIC-OBJS) $(XT-OBJS)
+	$(CAT)  $(GENERIC-OBJS) $(XT-OBJS) > $(TMP)/clim.fasl_`whoami`
+	$(MV) $(TMP)/clim.fasl_`whoami` climg.fasl
+	ls -lt climg.fasl >> Clim-sizes.n
+	ls -lt climg.fasl
+
+climxm.fasl	: $(MOTIF-OBJS)
+	$(CAT)  $(MOTIF-OBJS) > $(TMP)/clim.fasl_`whoami`
+	$(MV) $(TMP)/clim.fasl_`whoami` climxm.fasl
+	ls -lt climxm.fasl >> Clim-sizes.n
+	ls -lt climxm.fasl
+
+climol.fasl	: $(OPENLOOK-OBJS)
+	$(CAT)  $(OPENLOOK-OBJS) > $(TMP)/clim.fasl_`whoami`
+	$(MV) $(TMP)/clim.fasl_`whoami` climol.fasl
+	ls -lt climol.fasl >> Clim-sizes.n
+	ls -lt climol.fasl
 
 echo-fasls:
 	ls -lt $(MOTIF-OBJS) > /tmp/foo
@@ -222,9 +247,9 @@ clim-debug.fasl:	$(DEBUG-OBJS)
 	ls -lt clim-debug.fasl >> Clim-sizes.n
 	ls -lt clim-debug.fasl
 
-cat:	clim.fasl clim-debug.fasl
+# Building
 
-clim:	FORCE
+clim-xm:	FORCE
 	-$(RM) $(CLIM)
 	$(ECHO) " \
 		(setq *ignore-package-name-case* t) \
@@ -235,6 +260,19 @@ clim:	FORCE
 	ls -lt $(CLIM) >> Clim-sizes.n
 	ls -lt $(CLIM)
 
+
+clim-ol:	FORCE
+	-$(RM) $(CLIM)
+	$(ECHO) " \
+		(setq *ignore-package-name-case* t) \
+		(set-case-mode :case-insensitive-lower) \
+		(load \"misc/dev-load-ol.lisp\") \
+		(load \"misc/dump.lisp\")" | $(DUMP-CL) $(CLOPTS) -batch
+	$(MV) $(TMP)/clim.temp_`whoami` $(CLIM)
+	ls -lt $(CLIM) >> Clim-sizes.n
+	ls -lt $(CLIM)
+
+
 clim-small:	FORCE
 	$(ECHO) " \
 		(setq *ignore-package-name-case* t) \
@@ -245,11 +283,8 @@ clim-small:	FORCE
 	ls -lt $(CLIM-SMALL) >> Clim-sizes.n
 	ls -lt $(CLIM-SMALL)
 
-xm-composer:
-	cd tk ; $(MAKE) xm-composer
 
-xm-dcl:
-	cd tk ; $(MAKE) xm-dcl
+# Misc
 
 clean:
 	find $(DIRS) -name "*.fasl" -print | xargs rm -f ; rm -f clim.fasl
@@ -266,7 +301,7 @@ swm-tape:
 
 dist:
 	tar -cf - \
-	*/*.lisp *.lisp Makefile */Makefile \
+	*/*.lisp *.lisp Makefile */Makefile misc/make-stub-file \
 	misc/undefinedsymbols misc/undefinedsymbols.olit misc/undefinedsymbols.motif \
 	| compress >  Dist/src.tar.Z
 
@@ -279,3 +314,62 @@ echo_src_files:
 
 FORCE:
 
+################## Lower level Makefile stuff
+
+CL_SRC=/vapor/usr/tech/cer/cl/src
+OPENWINHOME=/usr/openwin-3.0
+
+#MOTIFHOME=/usr/motif
+#MOTIFLIB=$(MOTIFHOME)/usr/lib/libXm.a 
+#XLIBS=$(MOTIFHOME)/usr/lib/libXt.a $(MOTIFHOME)/usr/lib/libX11.a
+
+#MOTIFLIB=/x11/motif-1.1/lib/Xm/libXm.a
+#XLIBS=/x11/R4/src/mit/lib/Xt/libXt_d.a /x11/R4/src/mit/lib/X/libX_d.a 
+
+XLIBHOME=/misc
+MOTIFLIB=$(XLIBHOME)/libXm_d.a
+XLIBS=$(XLIBHOME)/libXt_d.a $(XLIBHOME)/libX_d.a
+
+#OLXLIBS=$(XLIBS)
+OLCOPYLIB=/usr/tech/cer/stuff/clim-2.0/tk/lib2/
+OLXLIBS=$(OLCOPYLIB)/libXt.a $(OLCOPYLIB)/libX11.a
+#LIBXOL=$(OPENWINHOME)/lib/libXol.a
+LIBXOL=$(OLCOPYLIB)/libXol.a
+
+# This has to be kept consistent with xlib.lisp
+
+UNDEFS=misc/undefinedsymbols
+
+# This should be the same as load-xm
+
+XM_UNDEFS=misc/undefinedsymbols.motif
+
+# This should be the same as load-ol
+
+OL_UNDEFS=misc/undefinedsymbols.olit
+
+default	: xm-composer
+
+ol-dcl	:  stub-olit.o
+	cd $(CL_SRC) ; /bin/rm -f ucl ;\
+	 make ucl_xtras='$(PWD)/stub-olit.o $(LIBXOL) $(OLXLIBS)' dcl
+
+xm-dcl	: stub-motif.o
+	cd $(CL_SRC) ; /bin/rm -f ucl ;\
+	make ucl_xtras='$(PWD)/stub-motif.o $(MOTIFLIB) $(XLIBS)' dcl	
+
+stub-motif.c	: $(UNDEFS) $(XM_UNDEFS) misc/make-stub-file
+	misc/make-stub-file "void ___lisp_load_motif_stub ()" $(UNDEFS) $(XM_UNDEFS) > stub-motif.c 
+
+stub-olit.c	: $(UNDEFS) $(OL_UNDEFS) misc/make-stub-file
+	misc/make-stub-file "void ___lisp_load_olit_stub ()" $(UNDEFS) $(OL_UNDEFS) > stub-olit.c 
+
+FRC	: 
+
+xm-composer : xm-dcl
+	cd /usr/composer2 ; make CL=/vapor/usr/tech/cer/cl/src/dcl rebuild-c2
+
+ol-composer : ol-dcl
+	cd /usr/composer2 ; make CL=/vapor/usr/tech/cer/cl/src/dcl rebuild-c2
+
+
diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index da99a5c10c191cb535800ca6db104886cb4c959d..9ce38997f49879fe6ad53f1e602f686815f4e396 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.9 92/03/04 16:21:04 cer Exp $
+;; $fiHeader: accept-values.lisp,v 1.11 92/03/10 10:12:13 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -197,6 +197,7 @@
 	(setf exit-button-stream
 	      (realize-pane 'clim-stream-pane
 			    :initial-cursor-visibility nil)))))
+  (:top-level (accept-values-top-level))
   (:menu-bar nil)
   (:command-table accept-values)
   (:command-definer nil))
@@ -275,6 +276,7 @@
 	 (bottom-margin 10))
      (if own-window
 	 (let ((frame (make-application-frame (or frame-class 'accept-values-own-window)
+					      :parent *application-frame*
 					      :calling-frame *application-frame*
 					      :continuation continuation
 					      :exit-boxes exit-boxes
@@ -1035,17 +1037,26 @@
 	 (formatting-cell (stream)
 	  (with-output-as-gadget (stream)
 	    (realize-pane 'push-button
+			  :activate-callback
+			  #'(lambda (gadget)
+			      (declare (ignore gadget))
+			      (com-abort-avv))
 			  :client frame
 			  :id :abort
 			  :label abort)))
 	 (formatting-cell (stream)
 	  (with-output-as-gadget (stream)
 	    (realize-pane 'push-button
+			  :activate-callback
+			  #'(lambda (gadget)
+			      (declare (ignore gadget))
+			      (com-exit-avv))
 			  :client frame
 			  :id :exit
 			  :label exit))))))))
 
 ;; Callback for exit boxes
+#+ignore
 (defmethod activate-callback ((button push-button) (client accept-values) id)
   (ecase id
     (:abort (com-abort-avv))
@@ -1060,6 +1071,7 @@
     (setf value new-value
 	  changed-p t)))
 
+#+ignore
 (defmethod value-changed-callback :around ((gadget value-gadget)
 					   (client accept-values-stream) id new-value)
   (declare (ignore new-value))
@@ -1067,15 +1079,29 @@
     ;; Only call the callback if the query is still valid
     (call-next-method)))
 
-;; Callback for value gadgets
+#+ignore
 (defmethod value-changed-callback ((gadget value-gadget)
 				   (client accept-values-stream) id new-value)
   (do-avv-command new-value client id))
 
+#+ignore
 (defmethod value-changed-callback ((gadget radio-box)
 				   (client accept-values-stream) id new-value)
   (do-avv-command (gadget-id new-value) client id))
 
+
+(defun accept-values-value-changed-callback (gadget new-value stream query-id)
+  (declare (ignore gadget))
+  (when (accept-values-query-valid-p (accept-values-query-presentation query-id))
+    ;; Only call the callback if the query is still valid
+    (do-avv-command new-value stream query-id)))
+
+(defun make-accept-values-value-changed-callback (stream query-id)
+  ;; We attach a callback function directly now
+  `(,#'accept-values-value-changed-callback ,stream ,query-id))
+
+;;;;;;;;;;;;;;;
+
 (defun do-avv-command (new-value client id)
   (throw-highlighted-presentation
    (make-instance 'standard-presentation
@@ -1092,27 +1118,46 @@
 
 ;; This is how we associate an output-record with the button
 (defmethod invoke-accept-values-command-button
-    	   (stream continuation (view gadget-dialog-view) prompt
-	    &key (documentation (if (stringp prompt)
-				    prompt
-				    (with-output-to-string (stream)
-				      (funcall prompt stream))))
-		 (query-identifier (list ':button documentation))
-		 (cache-value t) (cache-test #'eql)
-		 resynchronize)
+    (stream continuation (view gadget-dialog-view) prompt
+     &key (documentation (if (stringp prompt)
+			     prompt
+			   (with-output-to-string (stream)
+			     (funcall prompt stream))))
+	  (query-identifier (list ':button documentation))
+	  (cache-value t) (cache-test #'eql)
+	  resynchronize)
   (declare (dynamic-extent prompt))
   (updating-output 
    (stream :unique-id query-identifier :id-test #'equal
 	   :cache-value cache-value :cache-test cache-test)
    (with-output-as-gadget (stream)
-     (realize-pane 'push-button
-		   :label prompt
-		   :id (stream-current-output-record (slot-value stream 'stream))
-		   :client (make-instance 'accept-values-command-button
-					  :continuation continuation
-					  :documentation documentation
-					  :resynchronize resynchronize)))))
-
+     (let ((id (stream-current-output-record (slot-value stream
+							 'stream)))
+	   (client (make-instance 'accept-values-command-button
+				  :continuation continuation
+				  :documentation documentation
+				  :resynchronize resynchronize)))
+       (realize-pane 'push-button
+		     :activate-callback
+		     #'(lambda (button)
+			 (when (accept-values-query-valid-p id)
+			   (throw-highlighted-presentation
+			    (make-instance 'standard-presentation
+					   :object `(com-avv-command-button ,client ,id)
+					   :type 'command)
+			    *input-context*
+			    ;;--- It would be nice if we had the real event...
+			    (make-instance 'pointer-button-press-event
+					   :sheet (sheet-parent button)
+					   :x 0
+					   :y 0
+					   :modifiers 0
+					   :button 256))))
+		     :label prompt
+		     :id id
+		     :client client)))))
+
+#+ignore
 (defmethod activate-callback ((button push-button)
 			      (client accept-values-command-button) id)
   (when (accept-values-query-valid-p id)
diff --git a/clim/command-processor.lisp b/clim/command-processor.lisp
index fce22fadf8c584dcc81f98edc8d7514529e9f911..389105271bdb443e0250c457734dd6199824ddab 100644
--- a/clim/command-processor.lisp
+++ b/clim/command-processor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: command-processor.lisp,v 1.4 92/03/04 16:21:13 cer Exp $
+;; $fiHeader: command-processor.lisp,v 1.5 92/03/10 10:12:20 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -46,9 +46,11 @@
 	   (with-accept-help ((:top-level-help #'command-help))
 	     (multiple-value-bind (command final-delimiter)
 		 (invoke-command-name-parser-and-collect-1 
-		   command-name arg-parser delimiter-parser stream)
-	       (if (member final-delimiter *command-previewers*
-			   :test #'keyboard-event-matches-gesture-name-p)
+		  command-name arg-parser delimiter-parser stream)
+	       ;;-- In the cad demo this ends up as NIL. Is that ok??
+	       (if (and final-delimiter
+			(member final-delimiter *command-previewers*
+			   :test #'keyboard-event-matches-gesture-name-p))
 		   (with-input-editor-typeout (stream)
 		     (accept-values-command-parser
 		       command-name command-table 
diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp
index 1e10d74c141c6a0d09b4ad656b7d9e70ed8c4521..586c16235a199da6786ef529f61aff01a5fbdd33 100644
--- a/clim/db-stream.lisp
+++ b/clim/db-stream.lisp
@@ -22,7 +22,7 @@
 ;;;
 ;;; Copyright (c) 1990 by Xerox Corporations.  All rights reserved.
 ;;;
-;; $fiHeader: db-stream.lisp,v 1.8 92/02/24 13:07:16 cer Exp $
+;; $fiHeader: db-stream.lisp,v 1.9 92/03/04 16:21:21 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -193,6 +193,7 @@
 
 (defclass interactor-pane (clim-stream-pane) ())
 (defclass application-pane (clim-stream-pane) ())
+(defclass pointer-documentation-pane (clim-stream-pane) ())
 (defclass command-menu-pane (clim-stream-pane) ())
 
 (defmethod compose-space :before ((pane command-menu-pane) &key width height)
@@ -268,9 +269,9 @@
     (when text-record (replay text-record stream))))
 
 (defmethod window-erase-viewport ((stream window-stream))
-  (with-output-recording-options (stream :record nil)
+  (with-sheet-medium (medium stream)
     (multiple-value-call #'draw-rectangle*
-      (sheet-medium stream)
+      medium
       (bounding-rectangle* (or (pane-viewport stream)
 			       stream))
       :ink +background-ink+)))
@@ -330,6 +331,15 @@
 ;; location.  It does NOT do any cleaning up after itself.  It does not side-effect
 ;; the output history of the window.  It calls COPY-AREA whose contract is to 
 ;; do the above, the whole above, and nothing but the above.
+
+;;;---
+(defmethod window-shift-visible-region ((window t)
+					old-left old-top old-right old-bottom
+					new-left new-top new-right
+					new-bottom)
+  (declare (ignore old-left old-top old-right old-bottom new-left new-top new-right new-bottom))
+  nil)
+
 (defmethod window-shift-visible-region ((window clim-stream-sheet)
 					old-left old-top old-right old-bottom
 					new-left new-top new-right new-bottom)
diff --git a/clim/frames.lisp b/clim/frames.lisp
index 399c2424097cc92034514cbe37af83cdd23df00d..c036717aeab818965738e4afec4f718735b85f8b 100644
--- a/clim/frames.lisp
+++ b/clim/frames.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; ;; $fiHeader: frames.lisp,v 1.9 92/03/04 16:21:35 cer Exp $
+;; ;; $fiHeader: frames.lisp,v 1.10 92/03/10 10:12:33 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -13,6 +13,7 @@
 ;;--- We should add an input event-queue to frames, so that other
 ;;--- processes can queue up requests.  This queue should be managed
 ;;--- like other event queues.  It can contains "command" events, too.
+
 (defclass standard-application-frame (application-frame)
     ;;--- Is it right for these to be SHEET accessors??
     ((name :initarg :name :accessor frame-name)
@@ -24,7 +25,7 @@
      ;; One of  T, NIL, or a command-table; used by the menu-bar
      (menu-bar :initarg :menu-bar :initform nil)
      (histories :initform nil)
-     (frame-manager :reader frame-manager :initarg :frame-manager)
+     (frame-manager :reader frame-manager)
      (calling-frame :reader frame-calling-frame :initarg :calling-frame)
      ;;--- How does ALL-PANES differ from PANES?
      (panes :initarg :panes :accessor frame-panes)
@@ -40,14 +41,26 @@
 		     :reader frame-current-layout)
      (default-size :initform nil :initarg :default-size)
      (shell :accessor frame-shell)
-     (port :reader port :initarg :port)
-     (graft :reader graft :initarg :graft)
+     (pointer-documentationp
+      :initarg :pointer-documentation
+      :reader frame-pointer-documentationp)
+     (pointer-documentation-pane :initform nil)
      (properties :initform nil :initarg :properties
 		 :accessor frame-properties))
-  (:default-initargs :top-level 'default-frame-top-level
-		     :frame-manager (find-frame-manager)
-		     :port (find-port)
-		     :graft (find-graft)))
+  (:default-initargs 
+      :pointer-documentation nil
+      :top-level 'default-frame-top-level))
+
+(defmethod port ((frame standard-application-frame))
+  (port (frame-manager frame)))
+
+(defmethod graft ((frame standard-application-frame))
+  (graft (frame-manager frame)))
+
+
+(defmethod frame-pointer-documentation-output ((frame standard-application-frame))
+  (with-slots (pointer-documentation-pane) frame
+    pointer-documentation-pane))
 
 #+CLIM-1-compatibility
 (define-compatibility-function (frame-top-level-window frame-top-level-sheet)
@@ -55,9 +68,20 @@
   (frame-top-level-sheet frame))
 
 (defmethod initialize-instance :after ((frame standard-application-frame) 
-				       &rest args &key frame-manager)
+				       &rest args &key 
+						  frame-manager
+						  (parent frame-manager))
   (declare (ignore args))
-  (adopt-frame frame-manager frame))
+  (let ((frame-manager
+	 (etypecase parent
+	   (null (find-frame-manager))
+	   (list (apply #'find-frame-manager parent))
+	   (frame-manager parent)
+	   (application-frame (frame-manager parent))
+	   (port (find-frame-manager :port parent))
+	   (sheet (frame-manager (pane-frame parent))))))
+    (setf (slot-value frame 'frame-manager) frame-manager)
+    (adopt-frame frame-manager frame)))
 
 ;; Default method does nothing
 (defmethod generate-panes ((framem standard-frame-manager)
@@ -80,6 +104,7 @@
   #+Genera (declare (zwei:indentation 1 25 2 3 3 1))
   (with-warnings-for-definition name define-application-frame
     (let (pane panes layout top-level menu-bar
+	  pointer-documentation
 	  command-definer command-table disabled-commands)
       (macrolet ((extract (name keyword default &optional (pair t))
 		   `(let ((entry (assoc ',keyword options)))
@@ -94,7 +119,9 @@
 				   `((assert (listp (rest entry)) (entry)
 					     "The remainder of ~S must be a list" entry)
 				     (setq ,name (rest entry)
-					   options (delete entry options)))))))))
+					   options (delete entry
+							   options)))))))))
+	(extract pointer-documentation :pointer-documentation nil)
 	(extract pane :pane nil)
 	(extract panes :panes nil nil)
 	(extract layout :layout nil nil)
@@ -148,7 +175,8 @@
 	   (defclass ,name ,superclasses ,slots
 	     ,@options
 	     (:default-initargs
-	       :menu-bar ',menu-bar
+		 :pointer-documentation ',pointer-documentation
+		 :menu-bar ',menu-bar
 	       ,@(and command-table `(:command-table ',(car command-table)))
 	       ,@(and top-level `(:top-level ',top-level))
 	       ,@(and panes `(:pane-constructors ,pane-constructors))
@@ -314,10 +342,16 @@
 	  (setq width  (space-requirement-width sr)
 		height (space-requirement-height sr))))
       ;;--- Don't bother with this if the size didn't change?
-      (allocate-space panes width height)
-      ;; This is quite likely not going to work
-      (when (frame-top-level-sheet frame)
-	(resize-sheet* (frame-top-level-sheet frame) width height)))))
+      ;;-- This is wrong We want to resize the top level sheet
+      ;;; (allocate-space panes width height)
+      (resize-sheet* 
+       (or (frame-top-level-sheet frame)
+	   panes)
+       width height
+       ;;-- we need to do this because if the wm has changed the sheet
+       ;; then this will not change its size but we need it to start
+       ;; the layout stuff
+       :force t))))
 
 (defmethod (setf frame-current-layout) (nv (frame standard-application-frame))
   (unless (eq (frame-current-layout frame) nv)
@@ -332,7 +366,6 @@
     ;; Now we want to give it some new ones
     (generate-panes (frame-manager frame) frame)
     (sheet-adopt-child (frame-top-level-sheet frame) (frame-panes frame))
-    (clear-space-requirement-caches-in-tree (frame-panes frame))
     (multiple-value-call #'layout-frame
       frame (bounding-rectangle-size (frame-top-level-sheet frame)))
     (throw 'layout-changed nil)))
@@ -480,28 +513,34 @@
   (loop
     (catch 'layout-changed
       (let* ((*standard-output*
-	       (or (frame-standard-output frame) *standard-output*))
+	      (or (frame-standard-output frame) *standard-output*))
 	     (*standard-input* 
-	       (or (frame-standard-input frame) *standard-output*))
+	      (or (frame-standard-input frame) *standard-output*))
 	     (*query-io* 
-	       (or (frame-query-io frame) *standard-input*))
+	      (or (frame-query-io frame) *standard-input*))
 	     (*error-output* 
-	       (or (frame-error-output frame) *standard-output*))
+	      (or (frame-error-output frame) *standard-output*))
 	     (interactor
-	       (not (null (find-frame-pane-of-type frame 'interactor-pane))))
+	      (not (null (find-frame-pane-of-type frame 'interactor-pane))))
 	     (*command-parser*
-	       (or command-parser
-		   (if interactor
-		       #'command-line-command-parser
-		       #'menu-command-parser)))
+	      (or command-parser
+		  (if interactor
+		      #'command-line-command-parser
+		    #'menu-command-parser)))
 	     (*command-unparser*
-	       (or command-unparser 
-		   #'command-line-command-unparser))
+	      (or command-unparser 
+		  #'command-line-command-unparser))
 	     (*partial-command-parser* 
-	       (or partial-command-parser
-		   (if interactor
-		       #'command-line-read-remaining-arguments-for-partial-command
-		       #'menu-read-remaining-arguments-for-partial-command))))
+	      (or partial-command-parser
+		  (if interactor
+		      #'command-line-read-remaining-arguments-for-partial-command
+		    #'menu-read-remaining-arguments-for-partial-command)))
+	     (command-stream
+	      (typecase *standard-input*
+		(output-protocol-mixin
+		 *standard-input*)
+		(t
+		 (frame-top-level-sheet frame)))))
 	#+Allegro
 	(unless (typep *standard-input* 'excl::bidirectional-terminal-stream)
 	  (assert (port *standard-input*)))
@@ -521,7 +560,7 @@
 	      (if (stringp prompt)
 		  (write-string prompt *standard-input*)
 		  (funcall prompt *standard-input* frame)))
-	    (let ((command (read-frame-command frame :stream *standard-input*)))
+	    (let ((command (read-frame-command frame :stream command-stream)))
 	      (when interactor
 		(terpri *standard-input*))
 	      ;; Need this check in case the user aborted out of a command menu
@@ -585,36 +624,40 @@
 (defun redisplay-frame-pane (frame pane &key force-p)
   (when (symbolp pane)
     (setq pane (get-frame-pane frame pane)))
-  (when (pane-display-function pane)
-    (let* ((ir (slot-value pane 'incremental-redisplay-p))
-	   (redisplay-p (if (listp ir) (first ir) ir))
-	   (check-overlapping (or (atom ir)	;default is T
-				  (getf (rest ir) :check-overlapping t))))
-      (with-simple-restart (nil "Skip redisplaying pane ~S" pane)
-	(loop
-	  (with-simple-restart (nil "Retry displaying pane ~S" pane)
-	    (return
-	      (let ((redisplay-record
-		      (and redisplay-p
-			   (let ((history (stream-output-history pane)))
-			     (when history
-			       #+compulsive-redisplay
-			       (when (> (output-record-count history) 1)
-				 (cerror "Clear the output history and proceed"
-					 "There is more than one element in this redisplay pane")
-				 (window-clear pane))
-			       (unless (zerop (output-record-count history))
-				 (output-record-element history 0)))))))
-		(cond ((and redisplay-p
-			    (or force-p (null redisplay-record)))
-		       (when force-p
-			 (window-clear pane))
-		       (invoke-pane-redisplay-function frame pane))
-		      (redisplay-p
-		       (redisplay redisplay-record pane 
-				  :check-overlapping check-overlapping))
-		      (t
-		       (invoke-pane-display-function frame pane)))))))))))
+  (cond ((pane-display-function pane)
+	 (let* ((ir (slot-value pane 'incremental-redisplay-p))
+		(redisplay-p (if (listp ir) (first ir) ir))
+		(check-overlapping (or (atom ir) ;default is T
+				       (getf (rest ir) :check-overlapping t))))
+	   (with-simple-restart (nil "Skip redisplaying pane ~S" pane)
+	     (loop
+	       (with-simple-restart (nil "Retry displaying pane ~S" pane)
+		 (return
+		   (let ((redisplay-record
+			  (and redisplay-p
+			       (let ((history (stream-output-history pane)))
+				 (when history
+				   #+compulsive-redisplay
+				   (when (> (output-record-count history) 1)
+				     (cerror "Clear the output history and proceed"
+					     "There is more than one element in this redisplay pane")
+				     (window-clear pane))
+				   (unless (zerop (output-record-count history))
+				     (output-record-element history 0)))))))
+		     (cond ((and redisplay-p
+				 (or force-p (null redisplay-record)))
+			    (when force-p
+			      (window-clear pane))
+			    (invoke-pane-redisplay-function frame pane))
+			   (redisplay-p
+			    (redisplay redisplay-record pane 
+				       :check-overlapping check-overlapping))
+			   (t
+			    (invoke-pane-display-function frame
+							  pane))))))))))
+	(force-p
+	 ;;-- Is there anything else we need to do?
+	 (stream-replay pane))))
 
 (defun invoke-pane-redisplay-function (frame pane &rest args)
   (declare (dynamic-extent args))
@@ -748,19 +791,15 @@
 (defmethod frame-error-output ((frame standard-application-frame))
   (frame-standard-output frame))
 
-;;--- Get this right
-(defmethod frame-pointer-documentation-output ((frame standard-application-frame))
-  nil)
-
 ;;--- This causes direct-manipulation and menu-driven applications not to
 ;;--- maintain histories.  Is there a better heuristic?
 (defmethod frame-maintain-presentation-histories ((frame standard-application-frame))
   (not (null (find-frame-pane-of-type frame 'interactor-pane))))
 
 ;;--- What should this really do?
-#+Allegro
-(defun notify-user (&rest ignore) 
-  (format excl::*initial-terminal-io* "Notify ~a~%" ignore))
+
+(defmethod notify-user (frame format-string &rest format-arguments) 
+  (apply #'port-notify-user (port frame) frame format-string format-arguments))
 
 
 ;;; Pointer documentation
diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp
index f67e24d6dff271dcd9953ba109f5f56ee10117ab..a9ca435333fb363ad8573ac5ce2dd23f0634e3b7 100644
--- a/clim/gadget-output.lisp
+++ b/clim/gadget-output.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: gadget-output.lisp,v 1.6 92/02/24 13:07:33 cer Exp $
+;; $fiHeader: gadget-output.lisp,v 1.7 92/03/04 16:21:37 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -130,6 +130,9 @@
       (let* (gadget
 	     (record
 	      (with-new-output-record (stream 'gadget-output-record record)
+		;;--- Do we really need to do this. under what
+		;;--- situations does this happen and why cant we loose
+		;;--- the gadget
 		(unless (setq gadget (output-record-gadget record))
 		  (associate-record-and-gadget
 		   record
@@ -204,9 +207,13 @@
   ;; value-key, test, sequence
   (with-output-as-gadget (stream)
     (let* ((gadget
-	     (realize-pane 'radio-box 
-			   :client stream
-			   :id query-identifier)))
+	    (realize-pane 'radio-box 
+			  :label (and (stringp prompt) prompt)
+			  :value-changed-callback
+			  (make-accept-values-value-changed-callback
+			   stream query-identifier)
+			  :client stream
+			  :id query-identifier)))
       (dolist (element sequence)
 	(realize-pane 'toggle-button 
 		      :value (and default-supplied-p
@@ -225,12 +232,20 @@
 						    present-p query-identifier
 						    &key (prompt t))
   (declare (ignore default-supplied-p present-p))
-  (with-output-as-gadget (stream)
-    (realize-pane 'toggle-button
-		  :client stream
-		  :id query-identifier
-		  :value default
-		  :label (and (stringp prompt) prompt))))
+  (let ((x (with-output-as-gadget (stream)
+	     (realize-pane 'toggle-button
+			   :client stream 
+			   :value-changed-callback
+			   (make-accept-values-value-changed-callback
+			    stream query-identifier)
+			   :id query-identifier
+			   :value default
+			   :label (and (stringp prompt) prompt)))))
+    ;;--- WE end up not making a new gadget sometimes, I think because
+    ;;--- we find a gadget already in the record so we need to modify
+    ;;-- the value!
+    (setf (gadget-value x) default)))
+    
 
 
 (define-presentation-method accept-present-default ((type integer)
@@ -242,6 +257,9 @@
   (declare (ignore present-p))
   (with-output-as-gadget (stream)
     (realize-pane 'slider
+		  :value-changed-callback
+		  (make-accept-values-value-changed-callback
+		   stream query-identifier)
 		  :client stream
 		  :width 100
 		  :value (if default-supplied-p default 0)
diff --git a/clim/menus.lisp b/clim/menus.lisp
index d9c388d5548b7623bafe1b26f17d2c8bbd30e70d..81492b4813f094eaf38360e8935e1c3d0bc6627f 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.14 92/03/06 09:08:44 cer Exp $
+;; $fiHeader: menus.lisp,v 1.15 92/03/10 10:12:44 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -24,8 +24,9 @@
   (and (boundp '*application-frame*)
        *application-frame*))
 
-(defun get-menu (&key server-path)
+(defun get-menu (&key port)
   (let ((frame (make-application-frame 'menu-frame
+				       :parent port
 				       :save-under t)))
     (values (slot-value frame 'menu) frame)))
 
@@ -61,9 +62,8 @@
 
 #+Silica
 (defresource menu (associated-window root)
-  :constructor (let* ((port (if (null root) (find-port) (port root)))
-		      (server-path (port-server-path port)))
-		 (get-menu :server-path server-path))
+  :constructor (let* ((port (if (null root) (find-port) (port root))))
+		 (get-menu :port port))
   :deinitializer (window-clear menu)
   ;; We used to have an initializer that set record-p, cleared the window, and set
   ;; the size.  Record-p is unnecessary because we explicitly bind it below
diff --git a/clim/recording-protocol.lisp b/clim/recording-protocol.lisp
index 79b8eb552934980d5424f8b2c4abdb37ae15cdbf..b8099a855f36662d36b896e99020d40d958e2192 100644
--- a/clim/recording-protocol.lisp
+++ b/clim/recording-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: recording-protocol.lisp,v 1.3 92/03/04 16:22:13 cer Exp $
+;; $fiHeader: recording-protocol.lisp,v 1.5 92/03/10 10:12:49 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -1139,6 +1139,7 @@
 		  ((stream-drawing-p stream) draw))
     (funcall continuation)))
 
+
 ;;; The following two are only called when STREAM-RECORDING-P is true and the
 ;;; characters are printable (see CHARACTER-DRAWING.LISP).
 (defmethod stream-add-string-output ((stream output-recording-mixin) string
diff --git a/demo/address-book.lisp b/demo/address-book.lisp
index 0d83fc7cdd250b06ccfc85dcce69522039875f23..74e8a19f20397983e8d56ec94b5edc4b18a3eb9f 100644
--- a/demo/address-book.lisp
+++ b/demo/address-book.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: address-book.lisp,v 1.1 92/01/31 14:31:57 cer Exp $
+;; $fiHeader: address-book.lisp,v 1.2 92/02/24 13:09:16 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
@@ -94,30 +94,35 @@
       (write-string number stream))))
 
 ;;; Define the application-frame for our application
+
 (define-application-frame address-book
-			  ()
-    ;; This application has two state variables, the currently displayed
-    ;; address and the window from which user queries should be read.
-    ((current-address :initform nil)
-     (interaction-pane )
-     (name-pane))
+    ()
+  ;; This application has two state variables, the currently displayed
+  ;; address and the window from which user queries should be read.
+  ((current-address :initform nil)
+   (interaction-pane )
+   (name-pane))
+  
   (:panes
-    ((interactor :interactor)
-     (menu :command-menu)
-     (address :application
-	      :incremental-redisplay t
-	      :display-function 'display-current-address)
-     (names :application
-	    :incremental-redisplay t
-	    :display-function 'display-names)))
+   (interactor
+    (scrolling ()
+	       (realize-pane 'interactor-pane)))
+   (address
+    (scrolling ()
+	       (realize-pane 'application-pane
+			     :incremental-redisplay t
+			     :display-function
+			     'display-current-address)))
+   (names
+    (scrolling ()
+	       (realize-pane 'application-pane
+			     :incremental-redisplay t
+			     :display-function 'display-names))))
   (:layout
-    ((default
-       (:column 1
-	(:row 1/2
-	 (address 1/2)
-	 (names :rest))
-	(menu :compute)
-	(interactor :rest))))))
+   (default
+       (vertically ()
+	(horizontally () address names)
+	interactor))))
 
 ;;; This is the display-function for the upper-left pane, which specified 
 ;;; :display-function '(incremental-redisplay-display-function display-current-address).
diff --git a/demo/cad-demo.lisp b/demo/cad-demo.lisp
index 6a28ba65a8ef03ca2cae1a5f928831cec60834fa..26f11942c7028adbccc8596ad58e1f539ec8eceb 100644
--- a/demo/cad-demo.lisp
+++ b/demo/cad-demo.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cad-demo.lisp,v 1.2 92/02/24 13:09:20 cer Exp $
+;; $fiHeader: cad-demo.lisp,v 1.3 92/03/04 16:22:58 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
@@ -499,9 +499,13 @@
       (cond ((eq ink +background-ink+)
 	     ;;--- gee, am I getting carried away?
 	     (multiple-value-bind (nx ny)
-		 (drawing-surface-to-viewport-coordinates stream x y)
-	       (decf ny *component-size*)
-	       (window-clear-area stream (- nx 10) (- ny 10) nx (+ ny 20))))
+		 #+ignore drawing-surface-to-viewport-coordinates
+		 (values x y)
+		 (decf ny *component-size*)
+		 (with-sheet-medium (medium stream)
+		   (draw-rectangle* medium
+				    (- nx 10) (- ny 10) nx (+ ny 20)
+				    :ink +background-ink+))))
 	    (t
 	     (draw-text* stream name (- x 10) (- y 10)))))))
 
@@ -527,32 +531,33 @@
 
 ;;; First define a "application" that manages the application's state variables
 ;;; and defines a high-level division of screen real estate.
+
+
+
 (define-application-frame cad-demo
 			  (standard-application-frame output-record)
-    ((object-list :initform nil))
+  ((object-list :initform nil))
   (:panes
-    ((title :title
-	    :display-string "Mini-CAD")
-     (menu :command-menu)
-     (design-area :application)
-     (documentation :pointer-documentation)))
+   (design-area 
+    (realize-pane 'application-pane)))
+  (:pointer-documentation t)
   (:layout
-    ((main
-       (:column :rest
-	(title :compute)
-	(menu :compute)
-	(design-area :rest)
-	(documentation :compute)))
-     (other
-       (:column :rest
-	(title :compute)
-	(:row :rest
-	 (menu :compute)
-	 (design-area :rest))
-	(documentation :compute)))))
+   (:default
+       (scrolling ()
+		  design-area)))
   (:top-level
     (default-frame-top-level :partial-command-parser cad-demo-partial-command-parser)))
 
+;;--- I am amazed every day by something
+;; and this was it today !!!!
+
+(defmethod initialize-instance :around ((cd cad-demo) &key)
+  (call-next-method)
+  (let ((dp (get-frame-pane cd 'design-area)))
+    ;;--- kludge this one pane
+    (setf (stream-output-history dp) cd)
+    (setf (stream-recording-p dp) nil)))
+  
 (defun cad-demo-partial-command-parser (partial-command command-table stream start-location)
   (let ((name (command-name partial-command)))
     (if (eq name 'com-create-component)
@@ -675,6 +680,7 @@
 ;(make-component-prototypes)
 
 ;;; Return the class name of the selected component
+
 (defun select-component (parent)
   (labels ((draw-icon-menu (menu presentation-type)
 	     (formatting-table (menu :x-spacing 5)
@@ -696,7 +702,7 @@
   (with-menu (menu parent)
     (let ((component (menu-choose-from-drawer
 		       menu 'menu-item #'draw-icon-menu)))
-      (class-name (class-of component)))))
+      (class-name (class-of component))))))
 
 
 
@@ -884,15 +890,17 @@
 (define-cad-demo-command (com-exit-CAD-demo :menu "Exit" :keystroke #\X)
     ()
   ;; assume called via run-cad-demo
-  (throw 'exit-cad-demo nil))
-
-(define-cad-demo-command (com-swap-layouts :menu "Swap Layouts")
-    ()
-  (let ((current-layout (frame-current-layout *application-frame*)))
-    (setf (frame-current-layout *application-frame*)
-	  (case current-layout
-	    (main 'other)
-	    (other 'main)))))
+  (frame-exit *application-frame*))
+
+;;;------------
+;;; Right now there is only one
+;(define-cad-demo-command (com-swap-layouts :menu "Swap Layouts")
+;    ()
+;  (let ((current-layout (frame-current-layout *application-frame*)))
+;    (setf (frame-current-layout *application-frame*)
+;	  (case current-layout
+;	    (main 'other)
+;	    (other 'main)))))
 
 #||
 
diff --git a/demo/navfun.lisp b/demo/navfun.lisp
index d79167cfdc18a828f06a6531463d36b8e5a3a3a7..f630c4010aa113fe1a8969c68219030e5b5e76cc 100644
--- a/demo/navfun.lisp
+++ b/demo/navfun.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: navfun.lisp,v 1.1 92/01/31 14:32:06 cer Exp $
+;; $fiHeader: navfun.lisp,v 1.2 92/02/24 13:09:28 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
@@ -220,11 +220,11 @@
   (draw-coastline *coastline*)
   (flet ((present-position (object)
 	   (present object (class-name (class-of object))
-		    :view +iconic-view+ :single-box t)))
+		    :view +gadget-view+ :single-box t)))
     (mapc #'present-position *position-list*))
   (flet ((present-route (object)
 	   (present object (class-name (class-of object))
-		    :view +iconic-view+ :single-box nil)))
+		    :view +gadget-view+ :single-box nil)))
     (mapc #'present-route *route-list*)
     (mapc #'present-route *victor-airway-list*)))
 
@@ -307,14 +307,14 @@
     (format stream "NDB ~A ~A" name longname)))
 
 #-Allegro
-(defclass intersection (named-position) ())
+(defclass named-intersection (named-position) ())
 
 #+Allegro
 (eval-when (compile load eval)
-  (defclass intersection (named-position) ()))
+  (defclass named-intersection (named-position) ()))
 
-(defmethod draw-position ((intersection intersection) stream &optional label)
-  (with-slots (longitude latitude) intersection
+(defmethod draw-position ((named-intersection named-intersection) stream &optional label)
+  (with-slots (longitude latitude) named-intersection
     (multiple-value-bind (x y) (scale-coordinates longitude latitude)
       (rounding-coordinates (x y)
 	(let ((color-args (and (color-stream-p stream)
@@ -343,7 +343,7 @@
 
 (define-presentation-type ground-position ())
 
-(define-presentation-method present (object (type ground-position) stream (view iconic-view) &key)
+(define-presentation-method present (object (type ground-position) stream (view gadget-view) &key)
   (draw-position object stream))
 
 
@@ -354,7 +354,7 @@
   (let ((*print-object-readably* acceptably))
     (format stream "~A" (position-name object))))
 
-(define-presentation-method present (object (type named-position) stream (view iconic-view)
+(define-presentation-method present (object (type named-position) stream (view gadget-view)
 				     &key)
   (draw-position object stream
 		 (and (typep object 'named-position)
@@ -372,7 +372,7 @@
 
 (define-presentation-type NDB ())
 
-(define-presentation-type intersection ())
+(define-presentation-type named-intersection ())
 
 (define-presentation-type visual-checkpoint ())
 
@@ -494,7 +494,7 @@
   (let ((*print-object-readably* acceptably))
     (format stream "~A" (route-name object))))
 
-(define-presentation-method present (object (type route) stream (view iconic-view) &key)
+(define-presentation-method present (object (type route) stream (view gadget-view) &key)
   (let ((drawing-args (if (color-stream-p stream)
 			  (list :ink +red+)
 			  '(:line-dashes t))))
@@ -522,7 +522,7 @@
   (let ((*print-object-readably* acceptably))
     (format stream "~A" (route-name object))))
 
-(define-presentation-method present (object (type victor-airway) stream (view iconic-view)
+(define-presentation-method present (object (type victor-airway) stream (view gadget-view)
 				     &key)
   (let ((drawing-args (if (color-stream-p stream)
 			  (list :ink +blue+)
@@ -1018,20 +1018,17 @@
 ;;; Flight-Planner user interface
 
 (define-application-frame Flight-Planner
-			  ()
-    ((fp-window))
-  (:panes ((title :title)
-	   (display :application)
-	   (commands :command-menu)
-	   (interactor :interactor)
-	   (documentation :pointer-documentation)))
-  (:layout ((default
-	      (:column 1
-	       (title :compute)
-	       (display :rest)
-	       (commands :compute)
-	       (interactor 1/5)
-	       (documentation :compute))))))
+    ()
+  ((fp-window))
+  (:panes 
+   (display (realize-pane 'application-pane))
+   (interactor (realize-pane 'interactor-pane)))
+  (:layout 
+   (default
+       (vertically 
+	()
+	(scrolling () display)
+	(scrolling () interactor)))))
 
 (define-Flight-Planner-command (com-Zoom-In :name t :menu t) ()
   (multiple-value-bind (longitude latitude)
@@ -1104,11 +1101,11 @@
 
 (defun route-start-object-p (thing)		;--- kludge!
   (or (typep thing 'airport)
-      (typep thing 'intersection)
+      (typep thing 'named-intersection)
       (typep thing 'vor)))
 
 (define-presentation-type-abbreviation route-start-object ()
-  '(or airport intersection vor))
+  '(or airport named-intersection vor))
 
 ;;; Add <kind>
 (define-Flight-Planner-command (com-Add-Object :name t :menu "Add")
@@ -1122,17 +1119,17 @@
     (ground-position
       (let ((new-position (query-new-position)))
 	(when new-position
-	  (present new-position 'ground-position :view +iconic-view+)
+	  (present new-position 'ground-position :view +gadget-view+)
 	  (push new-position *position-list*))))
     (route
       (let* ((new-route (query-new-route :route-start route-start)))
 	(when new-route
-	  (present new-route 'route :view +iconic-view+)
+	  (present new-route 'route :view +gadget-view+)
 	  (push new-route *route-list*))))
     (victor-airway
       (let ((new-victor-airway (query-new-victor-airway)))
 	(when new-victor-airway
-	  (present new-victor-airway 'victor-airway :view +iconic-view+)
+	  (present new-victor-airway 'victor-airway :view +gadget-view+)
 	  (push new-victor-airway *victor-airway-list*))))
     (aircraft
       (let ((new-aircraft (query-new-aircraft)))
@@ -1158,7 +1155,7 @@
       (terpri *query-io*)
       (setq long-name (accept 'string :prompt "Long name"))
       (terpri *query-io*)
-      (setq kind (accept '(member airport vor intersection visual-checkpoint)
+      (setq kind (accept '(member airport vor named-intersection visual-checkpoint)
 			 :prompt "Kind of position"))
       (terpri *query-io*)
       (setq lat-and-long (accept 'latitude-and-longitude :prompt "Latitude, Longitude"))
@@ -1176,11 +1173,11 @@
 (defun waypoint-object-p (thing)		;--- kludge!
   (or (null thing)
       (typep thing 'airport)
-      (typep thing 'intersection)
+      (typep thing 'named-intersection)
       (typep thing 'vor)))
 
 (define-presentation-type-abbreviation waypoint-object ()
-  '(or null airport intersection vor))
+  '(or null airport named-intersection vor))
 
 (defun query-new-route (&key (name nil) (route-start nil))
   (do* ((overfly ())
@@ -1611,11 +1608,11 @@
   ;; Airports
   (add-position "HFD" 'airport (degminsec 41 44) (degminsec 72 39) 19  15 "Hartford-Brainard")
  
-  ;; Intersections
-  (add-position "DREEM" 'intersection (degminsec 42 21.6) (degminsec 71 44.3) 0 15 "DREEM")
-  (add-position "GRAYM" 'intersection (degminsec 42 06.1) (degminsec 72 01.9) 0 15 "GRAYM")
-  (add-position "WITNY" 'intersection (degminsec 42 03) (degminsec 72 14.2) 0 15 "WITNY")
-  (add-position "EAGRE" 'intersection (degminsec 41 45) (degminsec 72 20.6) 0 15 "EAGRE")
+  ;; Named-Intersections
+  (add-position "DREEM" 'named-intersection (degminsec 42 21.6) (degminsec 71 44.3) 0 15 "DREEM")
+  (add-position "GRAYM" 'named-intersection (degminsec 42 06.1) (degminsec 72 01.9) 0 15 "GRAYM")
+  (add-position "WITNY" 'named-intersection (degminsec 42 03) (degminsec 72 14.2) 0 15 "WITNY")
+  (add-position "EAGRE" 'named-intersection (degminsec 41 45) (degminsec 72 20.6) 0 15 "EAGRE")
 
   ;; VOR's
 
diff --git a/demo/puzzle.lisp b/demo/puzzle.lisp
index 419a0b0930bfdcefdc70985b15d3e28434635d95..d107c2823f39f33f872a40f243a37a14c3fa0837 100644
--- a/demo/puzzle.lisp
+++ b/demo/puzzle.lisp
@@ -1,22 +1,28 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: puzzle.lisp,v 1.1 92/01/31 14:32:10 cer Exp $
+;; $fiHeader: puzzle.lisp,v 1.2 92/02/24 13:09:31 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
 "Copyright (c) 1989, 1990, 1991 Symbolics, Inc.  All rights reserved."
 
 (define-application-frame puzzle 
-			  ()
-    ((puzzle :initform (make-array '(4 4))
-	     :accessor puzzle-puzzle))
-  (:panes ((title :title)
-	   (menu :command-menu)
-	   (display :application
-		    :default-text-style '(:fix :bold :very-large)
-		    :scroll-bars nil
-		    :incremental-redisplay T
-		    :display-function 'draw-puzzle))))
+    ()
+  ((puzzle :initform (make-array '(4 4))
+	   :accessor puzzle-puzzle))
+  (:panes
+   (display
+    (outlining ()
+	       (realize-pane 'application-pane
+			     :text-cursor nil
+			     :width :compute
+			     :max-width +fill+
+			     :height :compute
+			     :max-height +fill+
+			     :incremental-redisplay T
+			     :display-function 'draw-puzzle))))
+  (:layout
+   (:default display)))
 
 (defmethod frame-query-io ((puzzle puzzle))
   (get-frame-pane puzzle 'display))
@@ -63,8 +69,11 @@
       (dotimes (column 4)
 	(setf (aref puzzle-array row column) (mod (1+ (encode-puzzle-cell row column)) 16))))))
 
-(defmethod draw-puzzle ((puzzle puzzle) stream)
-  (with-end-of-page-action (stream :allow)
+(defmethod draw-puzzle ((puzzle puzzle) stream &key max-width max-height)
+  (declare (ignore max-width max-height))
+  (with-text-style (stream  '(:fix :bold :very-large))
+   (with-end-of-page-action (stream :allow)
+      (with-end-of-line-action (stream :allow)
     (let ((puzzle-array (puzzle-puzzle puzzle)))
       ;; I'm not sure why the table sometimes draws in the wrong place if I don't do this
       (stream-set-cursor-position* stream 0 0)
@@ -81,7 +90,7 @@
 		      (unless (zerop value)
 			(with-output-as-presentation 
 			    (stream (encode-puzzle-cell row column) 'puzzle-cell)
-			  (format stream "~D" value))))))))))))))
+			  (format stream "~D" value))))))))))))))))
 
 (defun find-open-cell (puzzle)
   (dotimes (row 4)
diff --git a/demo/sysdcl.lisp b/demo/sysdcl.lisp
index 580e62724d07aa80488aeb231783f6a2280e2097..50359f7347df49fa9768531b40b55f6adc9c7b04 100644
--- a/demo/sysdcl.lisp
+++ b/demo/sysdcl.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: sysdcl.lisp,v 1.1 92/01/31 14:32:11 cer Exp $
+;; $fiHeader: sysdcl.lisp,v 1.5 92/03/04 16:23:04 cer Exp Locker: cer $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user)
 
@@ -22,28 +22,26 @@
 			    #+Allegro (frob-pathname "demo")
 			    #+CMU "/home/hornig/clim/rel-2/cmu/"
 			    #+CCL-2 "ccl;clim-2.0:fasls:"
-   :needed-systems (clim-standalone))
+;;;; :needed-systems (clim-standalone)
+			    )
 
   ("packages")
   ("aaai-demo-driver" :load-before-compile ("packages"))
   ("listener"       :load-before-compile ("aaai-demo-driver" "packages"))
   ("graphics-demos" :load-before-compile ("aaai-demo-driver" "packages")
 		    :features (not Minima))
-  #+++when-converted
+  ("puzzle"         :load-before-compile ("aaai-demo-driver" "packages"))
   ("cad-demo"	    :load-before-compile ("aaai-demo-driver" "packages")
 		    :features (not Minima))
-  #+++when-converted
   ("navdata"	    :load-before-compile ("packages")
 		    :features (not Minima))
-  #+++when-converted
   ("navfun"         :load-before-compile ("aaai-demo-driver" "navdata" "packages")
 		    :features (not Minima))
-  #+++when-converted
-  ("puzzle"         :load-before-compile ("aaai-demo-driver" "packages"))
-  #+++when-converted
-  ("address-book"   :load-before-compile ("aaai-demo-driver" "packages"))
-  #+++when-converted
-  ("thinkadot"      :load-before-compile ("aaai-demo-driver" "packages"))
+  ("address-book"   :load-before-compile ("aaai-demo-driver"
+					  "packages"))
+  ("thinkadot"      :load-before-compile ("aaai-demo-driver"
+					  "packages"))
+  
   ("demo-prefill" :features (and (not Silica) (or Genera Cloe-Runtime))))
 
 #+Genera
diff --git a/demo/thinkadot.lisp b/demo/thinkadot.lisp
index bfd51a1b5f9b976f21c2749432f10ea2b1f84f39..ac012ee0042140598941b09e18a2a8dca54c1451 100644
--- a/demo/thinkadot.lisp
+++ b/demo/thinkadot.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: thinkadot.lisp,v 1.2 92/02/24 13:09:34 cer Exp $
+;; $fiHeader: thinkadot.lisp,v 1.3 92/03/04 16:23:05 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
@@ -39,22 +39,24 @@
 
 
 (define-application-frame thinkadot ()
-    ((node1)
-     (node2)
-     (node3)
-     (node4)
-     (node5)
-     (node6)
-     (node7)
-     (node8)
-     (all-nodes)
-     (lexit)
-     (rexit))
-  (:panes ((display :application
-		    :display-function 'draw-the-display
-		    :incremental-redisplay t
-		    :scroll-bars nil)
-	   (menu :command-menu))))
+  ((node1)
+   (node2)
+   (node3)
+   (node4)
+   (node5)
+   (node6)
+   (node7)
+   (node8)
+   (all-nodes)
+   (lexit)
+   (rexit))
+  (:panes
+   (display
+    (realize-pane 'application-pane
+		  :display-function 'draw-the-display
+		  :incremental-redisplay t)))
+  (:layout
+   (:default (scrolling () display))))
 
 (defmethod initialize-instance :after ((frame thinkadot) &key)
   (multiple-value-bind (w h)
@@ -88,7 +90,9 @@
 (defvar *light-color* (make-gray-color 0.667))
 (defvar *dark-color* +black+)
 
-(defmethod draw-the-display ((frame thinkadot) stream)
+
+(defmethod draw-the-display ((frame thinkadot) stream &key max-width max-height)
+  (declare (ignore max-width max-height))
   (with-slots (all-nodes lexit rexit) frame
     (let ((id 0))
       (dolist (node all-nodes)
@@ -138,7 +142,8 @@
   (drop-a-marble node))
 
 (define-presentation-to-command-translator drop-a-marble
-    (entry-node com-drop-marble thinkadot)
+    (entry-node com-drop-marble thinkadot
+		:documentation "Drop Marble")
     (object)
   `(,object))
 
@@ -157,9 +162,6 @@
       (setf (td-node-direction node) nil))))
 
 (define-thinkadot-command (com-exit :menu T) ()
-  (let ((window (frame-top-level-sheet *application-frame*)))
-    (window-clear window)
-    (setf (window-visibility window) nil))
   (frame-exit *application-frame*))
 
 
diff --git a/misc/compile-xm.lisp b/misc/compile-xm.lisp
index 1eba2ebd5f5f4077d03d54b87ef98b1d699c1e80..db1d12e4a28346f013a0fedd294584e4e3a22f54 100644
--- a/misc/compile-xm.lisp
+++ b/misc/compile-xm.lisp
@@ -20,30 +20,9 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: compile-xm.lisp,v 1.5 92/03/09 17:42:03 cer Exp Locker: cer $
+;; $fiHeader: compile-xm.lisp,v 1.6 92/03/10 10:13:13 cer Exp Locker: cer $
 
 (in-package :user)
 
-(setq *ignore-package-name-case* t)
-(set-case-mode :case-insensitive-lower)
-(setf *load-source-file-info* t)
-(setf *record-source-file-info* t)
-(setf *load-xref-info* nil)
-(setf *record-xref-info* nil)
-(setf (sys:gsgc-switch :print) nil)
-(setf (sys:gsgc-switch :stats) nil)
-
-(setq *compile-print* nil)
-(unless (find-package 'excl-defsystem)
-  (compile-file-if-needed "sys/defsystem")
-  (let ((*enable-package-locked-errors* nil))
-    (load "sys/defsystem")))
-(unless (errorset (defsys::find-system 'motif-clim))
-  (load "sys/sysdcl"))
-(defsys::compile-system 'motif-clim :propagate t)
-(tenuring
- (defsys::load-system 'motif-clim))
-(compile-file-if-needed "test/test-suite")
-(load "demo/sysdcl")
-(defsys::compile-system 'clim-demo :propagate t)
-
+(load "misc/compile-1")
+(compile-it 'motif-clim)
diff --git a/misc/dev-load-xm.lisp b/misc/dev-load-xm.lisp
index 314bbb6cd3766cac927f214d4a7205956627b914..7773737f2b1e5839ff1db305571b6844e600f107 100644
--- a/misc/dev-load-xm.lisp
+++ b/misc/dev-load-xm.lisp
@@ -20,33 +20,8 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: dev-load-xm.lisp,v 1.3 92/02/26 10:24:03 cer Exp $
+;; $fiHeader: dev-load-xm.lisp,v 1.5 92/03/04 16:23:12 cer Exp Locker: cer $
 
-(excl::free (excl::malloc 131072))
 
-(setq *ignore-package-name-case* t)
-(set-case-mode :case-insensitive-lower)
-
-(tenuring
- (let ((*load-source-file-info* t)
-       (*load-xref-info* nil))
-   (let ((*enable-package-locked-errors* nil))
-     (load "sys/defsystem"))
-   (load "sys/sysdcl")))
-
-
-(tenuring 
- (let ((*load-source-file-info* t)
-       (*load-xref-info* nil)
-       (excl:*global-gc-behavior* nil))
-   (defsys::load-system 'motif-clim)))
-
-(compile-file-if-needed "test/test-suite")
-
-(tenuring
- (load "test/test-suite") 
- (load "misc/clos-preload.fasl" :if-does-not-exist nil))
-
-(load "demo/sysdcl")
-(tenuring
- (defsys::load-system 'clim-demo))
+(load "misc/dev-load-1")
+(load-it 'motif-clim)
diff --git a/misc/dump.lisp b/misc/dump.lisp
index c34b8fca5a17e63937ead34323fefc8958e2f669..488329b98774f231bc8ef3620dc361c71cfcd10f 100644
--- a/misc/dump.lisp
+++ b/misc/dump.lisp
@@ -20,12 +20,13 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: dump.lisp,v 1.1 92/02/16 20:31:29 cer Exp $
+;; $fiHeader: dump.lisp,v 1.3 92/03/04 16:23:13 cer Exp Locker: cer $
 
 ;; Assuming CLIM is loaded, dump it into /usr/tmp/clim.temp_$USER.
 (room t)
 (sys:resize-areas :global-gc t :old 1000000 :new 500000)
 (room t)
+
 (dumplisp :name (concatenate 'simple-string "/tmp/clim.temp_"
 			     (sys:getenv "USER"))
 	  :checkpoint nil)
diff --git a/notes/clim.todo b/notes/clim.todo
index fea3f74aa13853aff866330e9c435d95998de72e..775b75d64f0cb18899fec1439dde1eb764ef7a6e 100644
--- a/notes/clim.todo
+++ b/notes/clim.todo
@@ -1,4 +1,4 @@
-%%  $fiHeader: clim.todo,v 1.11 92/03/12 13:41:57 cer Exp Locker: cer $
+K%%  $fiHeader: clim.todo,v 1.12 92/03/13 09:55:56 cer Exp Locker: cer $
 
 %% ****************************************** SWM things
 
@@ -103,9 +103,6 @@
       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.
-  * [swm] 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
   * [swm] Modularize with load on demand/required modules
@@ -163,70 +160,67 @@
 %% ********************************************* CER things 
 
 % Silica back-ends
-  * [cer,jdi] Xt
-    - Motif
-    - OpenLook
+
 
 % Holes to fill in
-  * [cer] INPUT-PROTOCOL and the HANDLE-EVENT problem
-  - Why does INPUT-PROTOCOL-MIXIN define an input buffer?  What's wrong with the
-    sheet event queue?
-  - What we really need to do is maintain a separate input buffer for the stream,
-    then STREAM-READ-GESTURE should loop doing HANDLE-EVENT until something gets
-    inserted into the stream's input buffer.  When there is something in input
-    buffer, STREAM-READ-GESTURE should then process it.
-  * [cer] Define cursor protocol
-  * [cer] Rename DEFSYS package to CLIM-DEFSYS.
+ * [cer,1d] INPUT-PROTOCOL and the HANDLE-EVENT problem
+    - Why does INPUT-PROTOCOL-MIXIN define an input buffer?  What's wrong with the
+      sheet event queue?
+    - What we really need to do is maintain a separate input buffer for the stream,
+      then STREAM-READ-GESTURE should loop doing HANDLE-EVENT until something gets
+      inserted into the stream's input buffer.  When there is something in input
+      buffer, STREAM-READ-GESTURE should then process it.
+  * [cer,0.5d] Define cursor protocol
+  * [cer,0.5d] Rename DEFSYS package to CLIM-DEFSYS.
   * Sheet protocol.
-    - [cer] How do we deal with the case where a sheet has one children and its
+    - [cer,1d] 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 () () ())).
-  * [cer] Multiple layouts need to allow different size reqs for the sheets.
-  * [cer] The code for switching layouts needs to be cleaned up.
-  * [cer] Protocol to compute to the WM the desired geometry of the frame.
-  * [cer] When the viewport is resized in might need to be moved, for example, if
+  * [cer,1d] Multiple layouts need to allow different size reqs for the sheets.
+  * [cer,1d] The code for switching layouts needs to be cleaned up.
+  * [cer,0.5d] Protocol to compute to the WM the desired geometry of the frame.
+  * [cer,0.5d] 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. 
-  * [cer] Pointer documentation panes and other pane types,
-  * [cer] Gadget enable/disable protocol.
-  * [cer] On-demand scrollbars.
-  * [cer] Complete layout protocol
-  * [cer] Complete set of layout gadgets.
-  * [cer] writers for gadgets
-  * [cer] notify-user
-	
-% Cleanups
-  * [cer] Sort out the whole server path mechanism and make sure we can
+  * [cer,0.5d] Pointer documentation panes and other pane types,
+  * [cer,0.5d] Gadget enable/disable protocol.
+  * [cer,0.5] On-demand scrollbars.
+  * [cer,1d] Complete layout protocol
+  * [cer,1d] Complete set of layout gadgets.
+  * [cer,1d] notify-user
+  * [cer,1d] Sort out the whole server path mechanism and make sure we can
     windows where we want.
-
-% Bugs to fix
-  * [cer] What's the problem with radio-boxes and move-cursor-after.  The
+  * [cer,0.5d] 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. 
-  * [cer] why? #<standard-method STREAM-READ-CHAR-NO-HANG (motif-top-level-sheet) @ #x1b18eee>
-  * [cer] When default-text-margin slot yet bound, drawing on a unexposed window
+  * [cer,0.5d] When default-text-margin slot yet bound, drawing on a unexposed window
     can cause problems. 
-  * [cer] command parser uses the variable stream, + others.
-  * [cer] perhaps max widths ending up smaller than widths!
-  * [cer] :fill in box panes??
-  * [cer] why do we need a pane when we read commands?
-  * [cer] replay-output-record is not called on output-record-mixin!
+  * [cer,0.5d] command parser uses the variable stream, + others rather
+    than gensyms
+  * [cer, 0.5d] perhaps max widths ending up smaller than widths!
+	  * [cer,0.5d] replay-output-record is not called on output-record-mixin!
     See the method in recording-output-protocol.lisp
-  * [cer] I suspect that replay needs to intersect the region with the
+  * [cer,0.1d] I suspect that replay needs to intersect the region with the
     viewport
-  * [cer] why in the without-as-gadget code does the stream-redisplay
+  * [cer,0.5d] why in the without-as-gadget code does the stream-redisplay
     cause us to resuse an old output record and gadget.  in
     accept-present-default results in gadgets with the (old) wrong
     value being used.
+  * Menu enhancements
+    - separators in menus
+    - In active menu items
+    - Labels in menus
+    - Hierarchical menus
+  * Locking
+
 
 %% ******************************************* JDI things
 
 % Holes to fill in
-  * [jdi] Design and implement a colormap scheme
+  * [jdi,5d,d] Design and implement a colormap scheme
     - Poll the CLIM@BBN.COM mailing list to see what the requirements are.
 
-
 %% **************************************** UNASSIGNED things
 
 % Silica back-ends
@@ -265,7 +259,6 @@
   * [all] Should we do "stream relative" coordinates (as opposed to the current
     "parent relative" scheme) for output records?  It solves some problems, but
     introduces others. 
-  * silica::shift-code is undefined in the gesture code.
 
 % Final spec conformance checking
 % Beefing up the test suites.
@@ -276,6 +269,13 @@
   * [all] Surpass CLIM 1.0 performance goals.
   * Add port-level (graft-level? medium-level?) caches for inks.
 
+% Performance things
+  * Why does text-style-mapping need to call standardize-text-style -
+    in particular this interns like hell.
+  * transformers for draw-circle* and perhaps others.
+  * automagic replay-output-record to do with with-medium earlier on and use
+    that all the way through
+
 % User Guide.
 
 % Demos and example code.
diff --git a/silica/db-button.lisp b/silica/db-button.lisp
index 1f42fd76c3e21b84bc62d7189a6b50141c0b0f3a..82ccd6675c2125774cefce1b566df0ab8373e9f5 100644
--- a/silica/db-button.lisp
+++ b/silica/db-button.lisp
@@ -3,7 +3,7 @@
 "Copyright (c) 1990, 1991 International Lisp Associates.
  Portions copyright (c) 1991, 1992 by Symbolics, Inc.  All rights reserved."
 
-;; $fiHeader$
+;; $fiHeader: db-button.lisp,v 1.3 92/03/10 15:45:49 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -120,7 +120,8 @@
 ;; This is done in the (SETF GADGET-VALUE) method because that's where it 
 ;; would be done in, say, Motif.  (I.e. we'd pass the SET-GADGET-VALUE off
 ;; to Motif which would toggle the indicator.)
-(defmethod (setf gadget-value) :after (nv (pane toggle-button-pane))
+
+(defmethod (setf gadget-value) :after (nv (pane toggle-button-pane) &key)
   (when (port pane)
     ;; If it's not grafted, don't draw it.
     (with-sheet-medium (medium pane)
@@ -130,8 +131,8 @@
 	       (cx (+ left radius))
 	       (cy (+ top (round (- bottom top) 2))))
 	  (draw-circle* medium cx cy (round radius 2)
-			:ink (if (gadget-value pane) +foreground-ink+ +background-ink+))))))
-  (value-changed-callback pane (gadget-client pane) (gadget-id pane) nv))
+			:ink (if (gadget-value pane) +foreground-ink+
+			       +background-ink+)))))))
 
 (defmethod handle-event ((pane toggle-button-pane) (event pointer-button-press-event))
   (with-slots (armed) pane
diff --git a/silica/db-layout.lisp b/silica/db-layout.lisp
index b3ecc33f86c770e60cc3310e5222d4b78091e150..74135ec9704476088b17624741b1f03457d03efd 100644
--- a/silica/db-layout.lisp
+++ b/silica/db-layout.lisp
@@ -22,7 +22,7 @@
 ;;;
 ;;; Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved. 
 ;;;
-;; $fiHeader: db-layout.lisp,v 1.8 92/02/24 13:04:26 cer Exp $
+;; $fiHeader: db-layout.lisp,v 1.9 92/03/04 16:19:28 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -82,6 +82,9 @@
   nil)
 
 (defmethod note-sheet-region-changed :after ((pane layout-mixin) &key port)
+  (note-layout-mixin-region-changed pane :port port))
+   
+(defmethod note-layout-mixin-region-changed ((pane layout-mixin) &key port)
   (declare (ignore port))
   (multiple-value-bind (width height) (bounding-rectangle-size pane)
     (allocate-space pane width height)))
@@ -203,7 +206,8 @@
 	  
 
 (defmethod compose-space ((pane space-requirement-mixin) &key width height)
-  (slot-value pane 'space-requirement))
+  (or (slot-value pane 'space-requirement)
+      (slot-value pane 'initial-space-requirement)))
 
 (defmethod change-space-requirement ((pane space-requirement-mixin) &rest keys)
   (declare (dynamic-extent keys))
@@ -244,6 +248,22 @@ slot that defaults to NIL"))
 				    :max-height max-height
 				    :min-height min-height)))))
 
+(warn "duplicate?")
+
+(defmethod default-space-requirements ((pane basic-client-space-requirement-mixin) 
+				       &key (width 0)
+					    (min-width width)
+					    (max-width width)
+					    (height 0)
+					    (min-height height)
+					    (max-height height))
+  (values width
+	  min-width
+	  max-width
+	  height
+	  min-height
+	  max-height))
+
 ;;;;
 
 (defclass client-space-requirement-mixin (basic-client-space-requirement-mixin)
@@ -495,3 +515,19 @@ provided elsewhere"))
 		       sheet-permanently-enabled-mixin)
     ())
 
+
+;;-- Does this need to be more complicated.
+;; What is the correct behavior. Should it take a space requirement??
+;; and just call allocate-space
+
+(defclass bboard-pane (space-requirement-mixin layout-pane) 
+	  ())
+
+(defmethod allocate-space ((pane bboard-pane) width height)
+  (declare (ignore width height))
+  (dolist (child (sheet-children pane))
+    (let ((space-req (compose-space child)))
+      (resize-sheet* child 
+		     (space-requirement-width space-req)
+		     (space-requirement-height space-req)))))
+
diff --git a/silica/db-scroll.lisp b/silica/db-scroll.lisp
index d5dfeb0d32302c0bab6ae6efea5b5c871be2e654..8a037c5f9b06cc8ed354cf5a677c4dd13b29455b 100644
--- a/silica/db-scroll.lisp
+++ b/silica/db-scroll.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-scroll.lisp,v 1.7 92/03/09 17:41:12 cer Exp Locker: cer $
+;; $fiHeader: db-scroll.lisp,v 1.8 92/03/10 15:39:56 cer Exp Locker: cer $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright(c) 1991, 1992 International Lisp Associates.
@@ -60,7 +60,10 @@
 
 (defun update-scrollbars (vp)
   (with-bounding-rectangle* (minx miny maxx maxy)
-      (stream-output-history (sheet-child vp))
+    (let ((c (sheet-child vp)))
+      (if (typep c 'clim-internals::output-recording-mixin)
+	  (stream-output-history c)
+	c))
     (with-bounding-rectangle* (vminx vminy vmaxx vmaxy)
 	(viewport-viewport-region vp)
       (with-slots (horizontal-scrollbar vertical-scrollbar)
@@ -70,6 +73,10 @@
 	(update-scrollbar horizontal-scrollbar
 			  minx maxx vminx vmaxx)))))
 
+;;;--- In the case where the viewport is bigger than the window this
+;;;code gets things kind a wrong. Checkout the thinkadot puzzl. Its
+;;;cos (- (--) (- vminx)) is -ve
+
 (defun update-scrollbar (scrollbar minx maxx vminx vmaxx)
   (declare (optimize (safety 0) (speed 3)))
   (let*  ((size (truncate (* 100.0
@@ -120,7 +127,9 @@
 					      size)
   (declare (ignore sheet))
   (with-slots (viewport contents) client
-    (let* ((extent (stream-output-history contents))
+    (let* ((extent (if (typep contents 'clim-internals::output-recording-mixin)
+		       (stream-output-history contents)
+		     contents))
 	   (vp viewport)
 	   (viewport (viewport-viewport-region vp)))
       (case id
@@ -146,7 +155,7 @@
 			(/ value (- 100 size)))))
 	    :y (bounding-rectangle-min-y viewport)))))))
 
-(defun update-region (stream nminx nminy nmaxy nmaxx &key no-repaint)
+(defun update-region (stream nminx nminy nmaxx nmaxy &key no-repaint)
   ;;-- I suspect that we should pass in mins and maxs since this does
   ;;-- assume that the window origin is 0,0 and I think that this
   ;;-- causes the compass menu test to fail since there are graphics at
@@ -159,10 +168,10 @@
 		(> nmaxx r)
 		(> nmaxy b))
 	(setf (sheet-region stream)
-	  (make-bounding-rectangle  (min nminx (bounding-rectangle-min-x stream))
-				    (min nminy (bounding-rectangle-min-y stream))
-				    (max nmaxx (bounding-rectangle-max-x stream))
-				    (max nmaxy (bounding-rectangle-max-y stream))))))
+	  (make-bounding-rectangle  (min nminx l)
+				    (min nminy tt)
+				    (max nmaxx r)
+				    (max nmaxy b)))))
   #+ignore
   (let ((width (- nmaxx nminx))
 	(height (- nmaxy nminy)))
@@ -185,39 +194,54 @@
 	;;--- Is this the correct place
 	(update-scrollbars vp)
 	(with-bounding-rectangle* (nleft ntop nright nbottom) 
-	    (pane-viewport-region stream)
+	  (pane-viewport-region stream)
+	  ;;-- Do we really want to do this here??
+	  (update-region stream nleft ntop nright nbottom)
 	  (cond
-	    ;; if some of the stuff that was previously on display is still on display
-	    ;; bitblt it into the proper place and redraw the rest.
-	    ((ltrb-overlaps-ltrb-p left top right bottom
-				   nleft ntop nright nbottom)
-	     ;; move the old stuff to the new position
-	     (window-shift-visible-region stream 
-					  left top right bottom
-					  nleft ntop nright nbottom)
-	     (let ((rectangles (ltrb-difference nleft ntop nright nbottom
-						left top right bottom)))
-	       (dolist (region rectangles)
-		 (with-sheet-medium (medium stream)
-		   (multiple-value-call #'draw-rectangle*
-		     medium
-		     (bounding-rectangle* region)
-		     :ink +background-ink+ :filled t))
-		 (replay (stream-output-history stream) stream region))))
-	 ;; otherwise, just redraw the whole visible viewport
-	 ;; Adjust for the left and top margins by hand so clear-area doesn't erase
-	 ;; the margin components.
-	 (t 
-	  (let ((region (viewport-viewport-region vp)))
-	    ;;---- We should make the sheet-region bigger at this point
-	    ;; Perhaps we do a union of the sheet-region and the viewport
-	    (with-sheet-medium (medium vp)
-	      (draw-rectangle* medium
-			       0 0 
-			       (bounding-rectangle-width region)
-			       (bounding-rectangle-height region)
-			       :ink +background-ink+ :filled t))
-	    (replay (stream-output-history stream) stream region)))))))))
+	   ;; if some of the stuff that was previously on display is still on display
+	   ;; bitblt it into the proper place and redraw the rest.
+	   ((ltrb-overlaps-ltrb-p left top right bottom
+				  nleft ntop nright nbottom)
+	    ;; move the old stuff to the new position
+	    #+ignore
+	    (break "before shifting ~S"
+		   (list (list left top right bottom)
+			 (list nleft ntop nright nbottom)))
+	    (window-shift-visible-region stream 
+					 left top right bottom
+					 nleft ntop nright nbottom)
+	    (let ((rectangles (ltrb-difference nleft ntop nright nbottom
+					       left top right
+					       bottom)))
+	      #+ignore
+	      (break "done shifting")
+	      (with-sheet-medium (medium stream)
+		(dolist (region rectangles)
+		  (multiple-value-call #'draw-rectangle*
+		    medium
+		    (bounding-rectangle* region)
+		    :ink +background-ink+ :filled t)
+		  #+ignore
+		  (break "cleared region ~S" region)
+		  (when (typep stream 'clim-internals::output-recording-mixin)
+		    (replay (stream-output-history stream) stream
+			    region))
+		  #+ignore
+		  (break "done replay")))))
+	   ;; otherwise, just redraw the whole visible viewport
+	   ;; Adjust for the left and top margins by hand so clear-area doesn't erase
+	   ;; the margin components.
+	   ((typep stream 'clim-internals::output-recording-mixin)
+	    (let ((region (viewport-viewport-region vp)))
+	      ;;---- We should make the sheet-region bigger at this point
+	      ;; Perhaps we do a union of the sheet-region and the viewport
+	      (with-sheet-medium (medium vp)
+		(draw-rectangle* medium
+				 0 0 
+				 (bounding-rectangle-width region)
+				 (bounding-rectangle-height region)
+				 :ink +background-ink+ :filled t))
+	      (replay (stream-output-history stream) stream region)))))))))
 
 
 
@@ -524,11 +548,13 @@
 	 (value (compute-symmetric-value min max coord min-value max-value)))
     (setf (gadget-value scroll-bar) value)))
 
-(defmethod (setf gadget-value) (nv (pane scroll-bar-pane))
+;;;-- This looks like a value gadget to me
+
+(defmethod (setf gadget-value) (nv (pane scroll-bar-pane) &key)
   (with-slots (value) pane
     (setf value nv)))
 
-(defmethod (setf gadget-value) :around (nv (pane scroll-bar-pane))
+(defmethod (setf gadget-value) :around (nv (pane scroll-bar-pane) &key)
   (declare (ignore nv))
   (if (port pane)
       (let ((shaft (slot-value pane 'shaft-pane)))
diff --git a/silica/db-slider.lisp b/silica/db-slider.lisp
index f76e833d3f594c23d4163b929c0d1b53a4023851..664d5d3fe39ab4d687a56da106f09ad989af86b8 100644
--- a/silica/db-slider.lisp
+++ b/silica/db-slider.lisp
@@ -3,7 +3,7 @@
 "Copyright (c) 1990, 1991 International Lisp Associates.
  Portions copyright (c) 1991, 1992 by Symbolics, Inc.  All rights reserved."
 
-;; $fiHeader$
+;; $fiHeader: db-slider.lisp,v 1.3 92/03/10 15:45:47 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -152,11 +152,8 @@
 	 (value (compute-symmetric-value min max coord min-value max-value)))
     (setf (gadget-value pane) value)))
 
-(defmethod (setf gadget-value) (nv (pane slider-pane))
-  (with-slots (value) pane
-    (setf value nv)))
 
-(defmethod (setf gadget-value) :around (nv (pane slider-pane))
+(defmethod (setf gadget-value) :around (nv (pane slider-pane) &key)
   (declare (ignore nv))
   (if (port pane)
       (with-sheet-medium (medium pane)
diff --git a/silica/framem.lisp b/silica/framem.lisp
index aeca9bb9e83dd2f7ed51732392abf35973d6ef1e..fb5b7e3dc18dda0681c997389d5cfad08d963069 100644
--- a/silica/framem.lisp
+++ b/silica/framem.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: framem.lisp,v 1.1 92/02/24 13:26:51 cer Exp $
+;; $fiHeader: framem.lisp,v 1.2 92/03/04 16:19:39 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -31,12 +31,13 @@
 
 (defvar *frame-managers* nil)
 
-(defun find-frame-manager (&rest options)
+(defun find-frame-manager (&rest options 
+			   &key (port (apply #'find-port options))
+				&allow-other-keys)
   (declare (dynamic-extent options))
-  (let ((port (apply #'find-port options)))
-    (second (or (assoc port *frame-managers*)
+  (second (or (assoc port *frame-managers*)
 		(car (push (list port (make-frame-manager port))
-			   *frame-managers*))))))
+			   *frame-managers*)))))
 
 (defmethod make-frame-manager (port)
   (cerror "Make a default frame manager"
@@ -62,7 +63,8 @@
 					      (bounding-rectangle-size top-pane)
 					    (make-bounding-rectangle 
 					      0 0 width height))
-				  :parent (find-graft)))))
+				  :parent (find-graft
+					   :port (port frame))))))
       (setf (frame-top-level-sheet frame) sheet
 	    (frame-shell frame) (sheet-shell sheet))
       (sheet-adopt-child sheet (frame-panes frame)))))
diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp
index c1d62cd3d8ae2fa5d8c60a24eb6db0f7dfc87b21..cbf2d84cea3d9011dc62c80a4e01969aa93957a0 100644
--- a/silica/gadgets.lisp
+++ b/silica/gadgets.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gadgets.lisp,v 1.10 92/03/06 14:17:30 cer Exp Locker: cer $
+;; $fiHeader: gadgets.lisp,v 1.11 92/03/10 10:11:39 cer Exp Locker: cer $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright (c) 1992 by Symbolics, Inc.  All rights reserved."
@@ -44,8 +44,7 @@
 (defun invoke-callback-function (function &rest args)
   (declare (dynamic-extent args))
   (if (consp function)
-      (with-stack-list* (args args (cdr function))
-	(apply (car function) args))
+      (apply (car function) (append args (cdr function)))
       (apply function args)))
 
 
@@ -70,14 +69,22 @@
   (with-slots (value) gadget
     (setf value new-value)))
 
-(defgeneric (setf gadget-value) (nv gadget))
+(defgeneric (setf gadget-value) (nv gadget &key))
 
-(defmethod (setf gadget-value) (nv (gadget value-gadget))
+(defmethod (setf gadget-value) (nv (gadget value-gadget) &key)
   (declare (ignore nv)))
 
-(defmethod (setf gadget-value) :after (nv (gadget value-gadget))
+;;-- What is the correct default?
+
+(defmethod (setf gadget-value) :after (nv (gadget value-gadget) &key invoke-callback)
   (with-slots (value) gadget
-    (setf value nv)))
+    (setf value nv))
+  (when invoke-callback
+    (value-changed-callback
+     gadget 
+     (gadget-client gadget)
+     (gadget-id gadget)
+     nv)))
 
 
 (defclass action-gadget (gadget) 
@@ -100,10 +107,9 @@
 (defclass labelled-gadget ()
     ((label :initarg :label
 	    :accessor gadget-label)
-     (alignment :initarg :halign		;--- compatibility hack
-		:initarg :alignment
+     (alignment :initarg :x-align
 		:accessor gadget-alignment))
-  (:default-initargs :label nil))
+  (:default-initargs :label nil :x-align :center))
 
 ;;--- Do the right thing
 #---ignore
@@ -166,7 +172,7 @@
 
 
 (defclass label-pane
-	  (labelled-gadget)
+	  (gadget labelled-gadget)
     ())
 
 
@@ -179,9 +185,11 @@
 	  (value-gadget oriented-gadget) 
     ((selections :initform nil 
 		 :reader radio-box-selections)
-     (current-selection :initform nil
-			:initarg :current-selection
-			:accessor radio-box-current-selection)))
+     ;;--- think about this
+     (value :initform nil
+	    :initarg :current-selection
+	    :initarg :current
+	    :accessor radio-box-current-selection)))
 
 (defmethod initialize-instance :after ((rb radio-box) &key choices)
   (let ((fr (pane-frame rb)))
@@ -202,7 +210,15 @@
 ;; As well as the callback mechanism a we want to specify a binding to commands
 (defclass text-field 
 	  (value-gadget action-gadget) 
-    ())
+	  ())
+
+(defclass text-editor (text-field) 
+	  ((ncolumns :initarg :ncolumns
+		     :accessor gadget-columns)
+	   (nlines :initarg :nlines
+		     :accessor gadget-lines))
+  (:default-initargs :ncolumns 1 :nlines 1))
+
 
 
 ;;; Viewport
@@ -223,12 +239,24 @@
 	  (make-bounding-rectangle 0 0 width height))))
 
 (defmethod allocate-space ((viewport viewport) width height)
-  ;; We do nothing to the child of a viewport
-  nil)
+  ;;-- Make sure the child is at least as big as the viewport
+  (let* ((child (sheet-child viewport)))
+    (multiple-value-bind
+	(cwidth cheight)
+	(bounding-rectangle-size child)
+      (when (or (< cwidth width)
+		(< cheight height))
+	(resize-sheet* child
+		       (max width cwidth)
+		       (max height cheight))))))
+		       
+
 
 (defmethod allocate-space :after ((viewport viewport) width height)
   (bounding-rectangle-set-size
-    (viewport-viewport-region viewport) width height)
+   (viewport-viewport-region viewport) width height)
+  ;; At this point  it might make sense to move the viewport if it is
+  ;; big enough to contain the contents
   (update-scrollbars viewport)
   (viewport-region-changed (sheet-child viewport) viewport))
 
diff --git a/silica/graphics.lisp b/silica/graphics.lisp
index ba2c43c490a9066364ea157203d2fc09f89f5473..e170062f78b4a0ca5439d4feb7cc4b90287f30e8 100644
--- a/silica/graphics.lisp
+++ b/silica/graphics.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graphics.lisp,v 1.5 92/02/24 13:04:38 cer Exp $
+;; $fiHeader: graphics.lisp,v 1.6 92/03/04 16:19:43 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -77,6 +77,63 @@
 
 (eval-when (compile load eval)
 
+(defun write-graphics-function-transformer (name 
+					    medium-graphics-function-name
+					    unspread-argument-names
+					    spread-arguments
+					    spread-name
+					    spread-argument-names
+					    drawing-options
+					    other-keyword-arguments
+					    arguments)
+  (declare (ignore spread-arguments))
+  (list
+   `(define-compiler-macro ,spread-name 
+	(&whole form 
+		medium-or-stream 
+		,@spread-argument-names &rest drawing-options-and-keyword-arguments)
+      (or (transform-graphics-function-call 
+	   medium-or-stream
+	   ',medium-graphics-function-name
+	   ',drawing-options
+	   ',other-keyword-arguments
+	   (list ,@spread-argument-names)
+	   drawing-options-and-keyword-arguments)
+	  form))
+   `(define-compiler-macro ,name 
+	(&whole form medium-or-stream ,@unspread-argument-names 
+	 &rest drawing-options-and-keyword-arguments)
+      (or (transform-graphics-function-call 
+	   medium-or-stream
+	   ',medium-graphics-function-name
+	   ',drawing-options
+	   ',other-keyword-arguments
+	   (list ,@unspread-argument-names)
+	   drawing-options-and-keyword-arguments
+	   ',arguments)
+	  form))))
+
+(defun generate-argument-spreading-code (x)
+  (if (consp x)
+      (destructuring-bind (argname type . names) x
+	(ecase type
+	  (point-sequence
+	   (destructuring-bind (new-name) names
+	     (values argname
+		     (list `(unspread-point-sequence ,argname))
+		     (list new-name))))
+	  (point
+	   (destructuring-bind (x y) names
+	     (values
+	      argname
+	      (list `(point-x ,argname)
+		    `(point-y ,argname))
+	      (list x y))))))
+    (values
+     x
+     (list x)
+     (list x))))
+
 (defun decode-graphics-function-arguments (arguments)
   (let* ((keyn (position '&key arguments))
 	 (no-keyword (subseq arguments 0 keyn))
@@ -85,24 +142,12 @@
 	 spread-arguments 
 	 spread-argument-names)
     (dolist (x no-keyword)
-      (if (consp x)
-	  (destructuring-bind (argname type . names) x
-	    (push argname unspread-argument-names)
-	    (ecase type
-	      (point-sequence
-		(destructuring-bind (new-name) names
-		  (push `(unspread-point-sequence ,argname) spread-arguments)
-		  (push new-name spread-argument-names)))
-	      (point
-		(destructuring-bind (x y) names
-		  (push `(point-x ,argname) spread-arguments)
-		  (push x spread-argument-names)
-		  (push `(point-y ,argname) spread-arguments)
-		  (push y spread-argument-names)))))
-	  (progn
-	    (push x unspread-argument-names)
-	    (push x spread-arguments)
-	    (push x spread-argument-names))))
+      (multiple-value-bind
+	  (argname spread-args spread-values)
+	  (generate-argument-spreading-code x)
+	  (push argname unspread-argument-names)
+	  (dolist (x spread-args) (push x spread-arguments))
+	  (dolist (x spread-values) (push x spread-argument-names))))
     (values (nreverse unspread-argument-names)
 	    (nreverse spread-arguments)
 	    (nreverse spread-argument-names)
@@ -113,7 +158,83 @@
 			(intern (symbol-name (if (consp x) (car x) x))
 				*keyword-package*))
 		    keyword))))
-)	;eval-when
+
+(defun transform-graphics-function-call (medium-or-stream
+					 medium-graphics-function-name
+					 drawing-options
+					 other-keyword-arguments
+					 required-arguments
+					 rest-argument
+					 &optional 
+					 arguments)
+  (let ((drawing-options
+	 (mapcar #'(lambda (x)
+		     (intern x :keyword))
+		 drawing-options)))
+    (flet ((kw-arg-keyword (x)
+	     (intern (if (consp x) (car x) x) :keyword))
+	   (kw-arg-default-value (x)
+	     (and (consp x) (second x))))
+      (when (do ((args rest-argument (cddr args)))
+		(nil)
+	      (cond ((null args) (return t))
+		    ((null (cdr args)) (return nil))
+		    ((not (or (member (car args) drawing-options)
+			      (dolist (arg other-keyword-arguments)
+				(when (eq (kw-arg-keyword arg) (car args))
+				  (return t)))))
+		     (return nil))))
+	(let (bindings)
+	  (when arguments
+	    (setq required-arguments
+	      (mapcan #'(lambda (arg req-arg)
+			  (let ((g (gensym)))
+			    (push (list g req-arg) bindings)
+			    (if (consp arg)
+				(nth-value
+				 1
+				 (generate-argument-spreading-code
+				  (cons g
+					(cdr arg))))
+			      (list g))))
+		      arguments
+		      required-arguments))
+	    (setq bindings (nreverse bindings)))
+	  (let* ((stuff
+		  (do ((args rest-argument (cddr args))
+		       (result nil))
+		      ((null args)
+		       (nreverse result))
+		    (let ((kw (car args))
+			  (value (cadr args)))
+		      (push (list kw (gensym) value) result))))
+		 (medium-or-stream-name (gensym))
+		 (call
+		  `(,medium-graphics-function-name
+		    ,medium-or-stream-name
+		    ,@required-arguments
+		    ,@(mapcar #'(lambda (kw-arg)
+				  (or 
+				   (second (assoc (kw-arg-keyword kw-arg) stuff))
+				   (kw-arg-default-value kw-arg)))
+			      other-keyword-arguments)))
+		 (supplied-drawing-options
+		  (mapcan #'(lambda (do)
+			      (let ((x (assoc do stuff)))
+				(and x (list do (second x)))))
+			  drawing-options)))
+	    
+	    `(let ((,medium-or-stream-name ,medium-or-stream))
+	       (let ,bindings
+		 (let ,(mapcar #'(lambda (x)
+				 (list (second x) (third x)))
+		      stuff)
+		 ,(if supplied-drawing-options
+		      `(with-drawing-options 
+			   (,medium-or-stream-name ,@supplied-drawing-options)
+			 ,call)
+		    call))))))))))
+)					;eval-when
 
 
 (defmacro transform-points ((transform) &rest points)
@@ -220,6 +341,16 @@
 	 (setf (get ',name 'args)
 	       '((,@spread-argument-names ,@keyword-argument-names)
 		 ,@args)) 
+	 ,@(write-graphics-function-transformer
+	    name 
+	    medium-graphics-function-name
+	    unspread-argument-names
+	    spread-arguments
+	    spread-name
+	    spread-argument-names
+	    drawing-options
+	    other-keyword-arguments
+	    arguments)
 	 (defmethod ,medium-graphics-function-name ((sheet sheet) 
 						    ,@spread-argument-names
 						    ,@keyword-argument-names)
@@ -250,6 +381,13 @@
 				  ,@spread-argument-names
 				  ,@keyword-argument-names)))))))
 
+
+
+
+
+
+	       
+			    
 
 (define-graphics-function draw-point ((point point x y))
   :drawing-options :point
diff --git a/silica/layout.lisp b/silica/layout.lisp
index b63d608340a1b27cae4ecb86d89041851feed0b9..9c8f73c9f5fe12170959c052fbec0ac8ad6f8f5f 100644
--- a/silica/layout.lisp
+++ b/silica/layout.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: layout.lisp,v 1.7 92/02/24 13:04:44 cer Exp $
+;; $fiHeader: layout.lisp,v 1.8 92/03/04 16:19:45 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -104,16 +104,18 @@
 		 ,@options))
 
 
-(defmethod resize-sheet* ((sheet sheet) width height)
+(defmethod resize-sheet* ((sheet sheet) width height &key force)
   (when (or width height)
-    (with-bounding-rectangle* (minx miny maxx maxy) sheet
-      (when (or (and width (/= (- maxx minx) width))
-		(and height (/= (- maxy miny) height)))
-	(setf (sheet-region sheet)
-	      (make-bounding-rectangle
-		minx miny
-		(if width (+ width minx) maxx)
-		(if height (+ height miny) maxy)))))))
+    (with-bounding-rectangle* 
+	(minx miny maxx maxy) sheet
+	(when (or force
+		  (and width (/= (- maxx minx) width))
+		  (and height (/= (- maxy miny) height)))
+	  (setf (sheet-region sheet)
+	    (make-bounding-rectangle
+	     minx miny
+	     (if width (+ width minx) maxx)
+	     (if height (+ height miny) maxy)))))))
 
 (defmethod move-and-resize-sheet* ((sheet sheet) minx miny width height)
   (resize-sheet* sheet width height)
@@ -291,18 +293,43 @@
 
 
 ;;--- CLIM 0.9 has some other methods on top-level sheets -- do we want them?
-(defclass top-level-sheet 
-	  (pane
-	   wrapping-space-mixin
-	   mirrored-sheet-mixin
-	   sheet-multiple-child-mixin)
-    ())
-
-(defmethod allocate-space ((sheet top-level-sheet) width height)
-  (resize-sheet* (first (sheet-children sheet)) width height))
 
-(defmethod compose-space ((sheet top-level-sheet) &key width height)
-  (compose-space (first (sheet-children sheet)) :width width :height height))
+(defclass top-level-sheet 
+    (
+     ;; Have these so that we can use 
+     clim-internals::window-stream
+     ;;
+     pane
+     wrapping-space-mixin
+     mirrored-sheet-mixin
+     sheet-multiple-child-mixin)
+    ()
+  (:default-initargs :text-cursor nil :text-margin 10))
+
+
+;; invoke-with-recording-options
+;; default-text-margin
+;; stream-read-gesture
+
+
+(defmethod note-layout-mixin-region-changed ((pane top-level-sheet) &key port)
+  (if port
+      (multiple-value-call #'layout-frame
+	(pane-frame pane) 
+	(bounding-rectangle-size pane))
+    (call-next-method)))
+
+;(defmethod allocate-space ((sheet top-level-sheet) width height)
+;  ;;--- To make openlook windows fill the vertical dimension we need
+;  ;;--- to do this why???. Actually doing this seems to make a lot of sense
+;  ;;--- Perhaps what should happen is that if the sheet-region is
+;  ;;--- changed by the port we should layout the entire frame instead
+;  (clear-space-requirement-caches-in-tree (first (sheet-children sheet)))
+;  ;;
+;  (resize-sheet* (first (sheet-children sheet)) width height))
+;
+;(defmethod compose-space ((sheet top-level-sheet) &key width height)
+;  (compose-space (first (sheet-children sheet)) :width width :height height))
 
 
 (defclass leaf-pane 
diff --git a/silica/macros.lisp b/silica/macros.lisp
index d9f3505cd98a55d823e153e2523075e3d88b6ef4..60cf9d1948d61fe1a0a66d391ab040f650906235 100644
--- a/silica/macros.lisp
+++ b/silica/macros.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: macros.lisp,v 1.5 92/03/04 16:19:46 cer Exp $
+;; $fiHeader: macros.lisp,v 1.6 92/03/10 10:11:41 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -53,14 +53,15 @@
      ,@body))
 
 
-(defmacro with-look-and-feel-realization ((frame-manager frame) &body forms)
-  `(macrolet ((realize-pane (pane-class &rest pane-options)
-		`(realize-pane-1 ,',frame-manager ,',frame ,pane-class
-				 ,@pane-options)))
+(defmacro with-look-and-feel-realization ((&optional frame-manager frame) &body forms)
+  (when (and (null frame) (null frame-manager))
+    (setq frame-manager `(frame-manager *application-frame*))
+    (setq frame `*application-frame*))
+  `(flet ((realize-pane (pane-class &rest pane-options)
+		(apply #'realize-pane-1 ,frame-manager ,frame pane-class pane-options)))
      ,@forms))
 
-(defmacro realize-pane (&whole form pane-class &rest pane-options)
+(defun realize-pane (pane-class &rest pane-options)
   (declare (ignore pane-class pane-options))
   (error "~S not inside a call to ~S"
-	 'realize-pane 'with-look-and-feel-realization)
-  form)
+	'realize-pane 'with-look-and-feel-realization))
diff --git a/silica/mirror.lisp b/silica/mirror.lisp
index bb71f0a1d3ba015a6776f4c8f6c04999ff3f7e55..67834d0be9e025dbe9dc2c81a032ddc7500de52c 100644
--- a/silica/mirror.lisp
+++ b/silica/mirror.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: mirror.lisp,v 1.11 92/03/06 14:17:31 cer Exp Locker: cer $
+;; $fiHeader: mirror.lisp,v 1.12 92/03/10 10:11:42 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -250,6 +250,8 @@
   ;; Compute transformation from sheet-region to mirror cordinates.
   (update-mirror-transformation-1 port sheet (sheet-parent sheet)))
 
+(defvar *check-mirror-transformation* nil)
+
 (defmethod update-mirror-transformation-1 ((port port) sheet parent)
   (declare (ignore parent))
   ;; would imagine that a lot of the time this would be identity
@@ -262,10 +264,11 @@
 		     (- right left)))
 	    (sc-y (/ (- mirror-bottom mirror-top)
 		     (- bottom top))))
-	(when (or (/= sc-x 1.0)
-		  (/= sc-y 1.0)
-		  (not (zerop tr-x))
-		  (not (zerop tr-y)))
+	(when (and *check-mirror-transformation*
+		   (or (/= sc-x 1.0)
+		       (/= sc-y 1.0)
+		       (not (zerop tr-x))
+		       (not (zerop tr-y))))
 	  (let (#+Allegro (*error-output* excl::*initial-terminal-io*))
 	    (warn "Mirror scaling ~S,~S,~S,~S" 
 		  (list tr-x tr-y sc-x sc-y) sheet
diff --git a/silica/port.lisp b/silica/port.lisp
index 671674a5dbbd882c773b7c449de76f52d2248fcf..76285a13e9c8bc6b55b826deec9136cc1f05182c 100644
--- a/silica/port.lisp
+++ b/silica/port.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: port.lisp,v 1.7 92/03/09 17:41:14 cer Exp Locker: cer $
+;; $fiHeader: port.lisp,v 1.8 92/03/10 10:11:43 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -68,13 +68,16 @@
   (mapc function *ports*))
 
 (defgeneric restart-port (port)
-  (:method
-    ((port port))
-    (when (port-process port)
-      (destroy-process (port-process port)))
-    (setf (port-process port)
-	  (make-process #'(lambda () (port-event-loop port))
-			:name "CLIM Event Dispatcher"))))
+  )
+
+(defmethod restart-port ((port port))
+  (when (port-process port)
+    (destroy-process (port-process port)))
+  (setf (port-process port)
+    (make-process #'(lambda () (port-event-loop port))
+		  :name (format nil
+				"CLIM Event Dispatcher for ~A"
+				(port-server-path port)))))
 
 (defgeneric port-event-loop (port)
   (:method ((port port))
@@ -110,12 +113,11 @@
   (:method ((x graft)) t)
   (:method ((x t)) nil))
 
-(defun find-graft (&key (port (find-port))
-			(server-path *default-server-path*)
-			(orientation :default)
-			(units :device))
-  (unless port
-    (setq port (find-port :server-path server-path)))
+(defun find-graft (&key 
+		   (server-path *default-server-path*)
+		   (orientation :default)
+		   (units :device)
+		   (port (find-port :server-path server-path)))
   (map-over-grafts #'(lambda (graft)
 		       (when (graft-matches-spec graft orientation units)
 			 (return-from find-graft graft)))
@@ -132,6 +134,8 @@
   (pushnew graft (port-grafts port))
   (realize-graft port graft))
 
+
+
 (defmethod update-mirror-region ((port port) (sheet graft))
   ;;--- I don't think we ever change the region of a graft...
   )
diff --git a/silica/sheet.lisp b/silica/sheet.lisp
index 85dcff926caf4431f510de9a461bdf362f375e51..a9f8e62a6cf484413017328b8ecbe26db9da932b 100644
--- a/silica/sheet.lisp
+++ b/silica/sheet.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: sheet.lisp,v 1.6 92/02/24 13:04:55 cer Exp $
+;; $fiHeader: sheet.lisp,v 1.7 92/03/04 16:19:55 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -52,8 +52,6 @@
       (error "Not one child:~S" sheet))
     (car x)))
 
-(defmethod sheet-shell (sheet) sheet)
-
 (defun map-over-sheets (function sheet)
   (declare (dynamic-extent function))
   (funcall function sheet)
diff --git a/sys/sysdcl.lisp b/sys/sysdcl.lisp
index 1649d2058605b6e6dbedf28a9a040d81ce0bbe30..db3f7877bd0706569be33dfeed08ee009f3a24fa 100644
--- a/sys/sysdcl.lisp
+++ b/sys/sysdcl.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: sysdcl.lisp,v 1.6 92/03/04 16:22:34 cer Exp $
+;; $fiHeader: sysdcl.lisp,v 1.8 92/03/10 10:13:03 cer Exp Locker: cer $
 
 (in-package #-ANSI-90 "USER" #+ANSI-90 :cl-user)
 
@@ -408,7 +408,7 @@
 
 
 #+(and Silica Allegro)
-(defsys:defsystem xlib-clim
+(defsys:defsystem xlib
     (:default-pathname (frob-pathname "xlib")
 	:default-binary-pathname (frob-pathname "xlib")
 	:needed-systems (clim-standalone)
@@ -424,11 +424,11 @@
 
 
 #+(and Silica Allegro)
-(defsys:defsystem xt-clim
+(defsys:defsystem xt-tk
     (:default-pathname (frob-pathname "tk")
      :default-binary-pathname (frob-pathname "tk")
-     :needed-systems (xlib-clim)
-     :load-before-compile (xlib-clim))
+     :needed-systems (xlib)
+     :load-before-compile (xlib))
   ;; General stuff
   ("pkg")
   ("foreign-obj")
@@ -453,11 +453,11 @@
   ("xt-init"))
 
 #+(and Silica Allegro)
-(defsys:defsystem xm-clim
+(defsys:defsystem xm-tk
     (:default-pathname (frob-pathname "tk")
      :default-binary-pathname (frob-pathname "tk")
-     :needed-systems (xt-clim)
-     :load-before-compile (xt-clim))
+     :needed-systems (xt-tk)
+     :load-before-compile (xt-tk))
   ;; Motif specific stuff
   ("xm-classes")
   ("xm-init")
@@ -471,11 +471,11 @@
   ("make-widget"))
 
 #+(and Silica Allegro)
-(defsys:defsystem ol-clim
+(defsys:defsystem ol-tk
     (:default-pathname (frob-pathname "tk")
      :default-binary-pathname (frob-pathname "tk")
-     :needed-systems (xt-clim)
-     :load-before-compile (xt-clim))
+     :needed-systems (xt-tk)
+     :load-before-compile (xt-tk))
   ;; OpenLook specific stuff
   ("ol-classes")
   ("ol-init")
@@ -487,8 +487,8 @@
 (defsys:defsystem motif-clim
     (:default-pathname (frob-pathname "xm-silica")
      :default-binary-pathname (frob-pathname "xm-silica")
-     :needed-systems (xm-clim)
-     :load-before-compile (xm-clim))
+     :needed-systems (clim-standalone xm-tk)
+     :load-before-compile (clim-standalone xm-tk))
   ("pkg")
   ("xt-silica")
   ("xm-silica")
@@ -507,8 +507,8 @@
 (defsys:defsystem openlook-clim
     (:default-pathname (frob-pathname "xm-silica")
      :default-binary-pathname (frob-pathname "xm-silica")
-     :needed-systems (ol-clim)
-     :load-before-compile (ol-clim))
+     :needed-systems (clim-standalone ol-tk)
+     :load-before-compile (clim-standalone ol-tk))
   ("pkg")
   ("xt-silica")
   ("ol-silica")
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index b2e34ebf9e6f241644a88b4a1c71d438092ba579..3867139ebf3fcd36565bb18810e1b2a0cf2277dc 100644
--- a/test/test-suite.lisp
+++ b/test/test-suite.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: test-suite.lisp,v 1.12 92/03/04 16:22:38 cer Exp Locker: cer $
+;; $fiHeader: test-suite.lisp,v 1.13 92/03/06 09:08:49 cer Exp Locker: cer $
 
 (in-package :clim-user)
 
@@ -2514,7 +2514,7 @@ Luke Luck licks the lakes Luke's duck likes."))
 (define-benchmark (simple-menu-choose :iterations 10) (stream)
   "Pop up a simple menu of colors"
   (without-clim-input
-    (if #+Allegro (typep (sheet-port stream) 'xm-silica::xt-port)
+    (if #+Allegro (typep (port stream) 'xm-silica::xt-port)
 	#-Allegro nil
 	(sleep 1) ;; Avoid division by zero!
 	(menu-choose '(("Red" :value +red+)
@@ -2532,7 +2532,7 @@ Luke Luck licks the lakes Luke's duck likes."))
 (define-benchmark (cached-menu-choose :iterations 10) (stream)
   "Pop up a cached menu of colors"
   (without-clim-input
-    (if #+Allegro (typep (sheet-port stream) 'xm-silica::xt-port)
+    (if #+Allegro (typep (port stream) 'xm-silica::xt-port)
 	#-Allegro nil
 	(sleep 1) ;; Avoid division by zero!
 	(menu-choose '(("Red" :value +red+)
diff --git a/test/test.lisp b/test/test.lisp
index 8a603ba115eb24cc9c142742ce7eea973fb3e6a5..811ad02e8a0aabce28fa3a76a9213d20ee591a0b 100644
--- a/test/test.lisp
+++ b/test/test.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: test.lisp,v 1.14 92/03/04 16:22:41 cer Exp Locker: cer $
+;; $fiHeader: test.lisp,v 1.15 92/03/09 17:41:57 cer Exp Locker: cer $
 
 (in-package :clim-user)
 
@@ -46,6 +46,12 @@
 
 
 (define-application-frame test-frame0 () ()
+  (:command-table test-frame)
+  (:pane 
+    (scrolling ()
+	       (realize-pane 'interactor-pane))))
+
+(define-application-frame test-frame01 () ()
   (:command-table test-frame)
   (:pane 
     (scrolling ()
@@ -217,20 +223,20 @@
       (setf (car weird)
 	    (with-output-as-presentation (stream weird 'some-kinda-gadget)
 	      (surrounding-output-with-border (stream)
-		(with-output-as-gadget (stream)
+		(clim-internals::with-output-as-gadget (stream)
 		  (realize-pane 'slider))))))
     (let ((weird (cons nil nil)))
       (setf (car weird)
 	    (with-output-as-presentation (stream weird 'some-kinda-gadget)
 	      (surrounding-output-with-border (stream)
-		(with-output-as-gadget (stream)
+		(clim-internals::with-output-as-gadget (stream)
 		  (realize-pane 'push-button
 				:label "Amazing"))))))
     (let ((weird (cons nil nil)))
       (setf (car weird)
 	    (with-output-as-presentation (stream weird 'some-kinda-gadget)
 	      (surrounding-output-with-border (stream)
-		(with-output-as-gadget (stream)
+		(clim-internals::with-output-as-gadget (stream)
 		  (scrolling ()
 		    (realize-pane 'interactor-pane)))))))))
 
@@ -259,7 +265,7 @@
     ()
   (let* ((stream *query-io*))
     (flet ((make-it (i)
-	     (with-output-as-gadget (stream)
+	     (clim-internals::with-output-as-gadget (stream)
 	       (realize-pane 
 		 'push-button
 		 :label (format nil "Amazing ~D" i)))))
@@ -274,7 +280,7 @@
 (define-test-frame-command (com-make-radio-box :name t :menu t)
     ()
   (let* ((stream *query-io*))
-    (with-output-as-gadget (stream)
+    (clim-internals::with-output-as-gadget (stream)
       (let* (#+ignore (frame-pane (realize-pane 'frame-pane))
 	     (gadget
 	       (realize-pane 'radio-box
@@ -338,3 +344,48 @@
 
 (defun slider-dragged-callback (slider value)
   (format t "~&Slider ~A dragged to ~S" (gadget-label slider) value))
+
+
+(defclass insect () ())
+
+(define-test-frame-command (com-make-insect :name t :menu t)
+    ()
+  (let ((i (make-instance 'insect)))
+    (with-output-as-presentation (t i (presentation-type-of i))
+      (print i))
+    (terpri)))
+
+(define-test-frame-command (com-describe-insect :name t :menu t)
+    ((bug 'insect
+	  :gesture (nil :menu t)
+	  :prompt "Select an insect"))
+  (describe bug))
+
+
+
+(define-application-frame tf99 () ()
+  (:command-table test-frame)
+  (:pane 
+    (vertically ()
+      (outlining ()
+	(horizontally ()
+	  (realize-pane 'push-button 
+			:label "B1"
+			:activate-callback 'push-button-callback)
+	  (realize-pane 'push-button 
+			:label "B2"
+			:activate-callback 'push-button-callback)))
+      (outlining ()
+	(horizontally ()
+	  (realize-pane 'toggle-button
+			:label "T1" 
+			:value-changed-callback 'toggle-button-callback)
+	  (realize-pane 'toggle-button 
+			:label "T2"
+			:value-changed-callback 'toggle-button-callback)))
+      (outlining ()
+	(spacing ()
+	  (realize-pane 'slider
+			:label "Slider"
+			:value-changed-callback 'slider-changed-callback
+			:drag-callback 'slider-dragged-callback))))))
diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp
index 5795e4e3ff06d410dc0a2da8deca8cb23528b815..909108cb0128fc3a0747fe9726ee36cf1b14c760 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.5 92/02/24 13:06:08 cer Exp $
+;; $fiHeader: ol-gadgets.lisp,v 1.6 92/03/04 16:20:30 cer Exp Locker: cer $
 
 
 (in-package :xm-silica)
@@ -30,6 +30,7 @@
   (second (assoc class '((scroll-bar openlook-scrollbar)
 			 (slider openlook-slider)
 			 (push-button openlook-push-button)
+			 (label-pane openlook-label-pane)
 			 (text-field openlook-text-field)
 			 (toggle-button openlook-toggle-button)
 			 (menu-bar openlook-menu-bar)
@@ -151,10 +152,6 @@
 		    :resize-callback 'sheet-mirror-resized-callback
 		    sheet))
 
-(warn "This is really bogus")
-
-(defmethod stream-read-char-no-hang ((x openlook-top-level-sheet))
-  nil)
 
 (defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port)
 						     (parent t)
@@ -263,3 +260,105 @@
 (defun command-button-callback-ol (button frame item)
   (command-button-callback button nil frame item))
 
+
+
+;;; Label pane
+
+(defclass openlook-label-pane (xt-leaf-pane silica::label-pane) 
+	  ())
+
+(defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port)
+						     (parent t)
+						     (sheet openlook-label-pane))
+  (with-accessors ((label gadget-label)
+		   (alignment gadget-alignment)) sheet
+    (values 'tk::static-text
+	    (append
+	     (list :alignment 
+		   (ecase alignment
+		     ((:left nil) :left)
+		     (:center :center)
+		     (:right :right)))
+	     (and label (list :string label))))))
+  
+;;; Push button
+
+(defclass openlook-push-button (xt-leaf-pane
+				push-button
+				openlook-action-pane) 
+	  ())
+
+
+
+(defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port)
+						     (parent t)
+						     (sheet openlook-push-button))
+  (declare (ignore port))
+  (with-accessors ((label gadget-label)) sheet
+    (values 'tk::menu-button 
+	    (and label (list :label label)))))
+
+;;
+
+
+(defclass openlook-action-pane () ())
+
+(defmethod add-sheet-callbacks :after ((port openlook-port) (sheet openlook-action-pane) (widget t))
+  (tk::add-callback widget
+		    :select
+		    'queue-active-event-ol
+		    sheet))
+
+(defmethod queue-active-event-ol ((widget openlook-action-pane) sheet)
+  (distribute-event
+   (port sheet)
+   (make-instance 'activate-gadget-event
+		  :gadget sheet)))
+
+
+;;; Text field
+
+(defclass openlook-text-field (xt-leaf-pane
+			       openlook-value-pane 
+			       openlook-action-pane
+			       text-field)
+	  ())
+
+(defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port)
+						     (parent t)
+						     (sheet openlook-text-field))
+  (with-accessors ((value gadget-value)) sheet
+    (values 'tk::text
+	    (append
+	     (and value `(:string ,value))))))
+
+
+;;; Value stuff
+;;; I suspect that this is worthless
+
+(defclass openlook-value-pane () ())
+
+(defmethod add-sheet-callbacks :after ((port openlook-port) (sheet
+							     openlook-value-pane) (widget t))
+  #+igore
+  (tk::add-callback widget
+		    :value-changed-callback
+		    'queue-value-changed-event
+		    sheet))
+
+(defmethod gadget-value ((gadget openlook-value-pane))
+  (if (sheet-direct-mirror gadget)
+      (tk::get-values (sheet-mirror gadget) :value)
+    (call-next-method)))
+
+(defmethod (setf gadget-value) (nv (gadget openlook-value-pane) &key)
+  (when (sheet-mirror gadget)
+    (tk::set-values (sheet-mirror gadget) :value nv)))
+
+(defmethod queue-value-changed-event (widget sheet)
+  (declare (ignore widget))
+  (distribute-event
+   (port sheet)
+   (make-instance 'value-changed-gadget-event
+		  :gadget sheet
+		  :value (gadget-value sheet))))
diff --git a/tk-silica/ol-silica.lisp b/tk-silica/ol-silica.lisp
index 052313be3443a249d9ec38e4e2c722a6c81fa056..16f0b86b179f134d20847c024180d020cbde1ab7 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.5 92/02/24 13:06:12 cer Exp $
+;; $fiHeader: ol-silica.lisp,v 1.6 92/03/04 16:20:32 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -32,7 +32,7 @@
   'openlook-port)
 
 (warn "Changing the default server path to ~S"
-      (setq *default-server-path* '(:openlook :display "localhost:0")))
+      (setq *default-server-path* '(:openlook)))
 
 (defmethod port-note-cursor-change ((port openlook-port)
 				    cursor stream type old new)
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index d79bc778937f122b757eecf1b61eb9286ca427eb..ddcca434c18d7738b3c4e067fc60fdd410ff4704 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.14 92/03/06 09:08:32 cer Exp $
+;; $fiHeader: xm-gadgets.lisp,v 1.16 92/03/10 10:12:02 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -29,6 +29,7 @@
 			 (push-button motif-push-button)
 			 (label-pane motif-label-pane)
 			 (text-field motif-text-field)
+			 (silica::text-editor motif-text-editor)
 			 (toggle-button motif-toggle-button)
 			 (menu-bar motif-menu-bar)
 			 (viewport xm-viewport)
@@ -66,7 +67,7 @@
       (tk::get-values (sheet-mirror gadget) :value)
     (call-next-method)))
 
-(defmethod (setf gadget-value) (nv (gadget motif-value-pane))
+(defmethod (setf gadget-value) (nv (gadget motif-value-pane) &key)
   (when (sheet-mirror gadget)
     (tk::set-values (sheet-mirror gadget) :value nv)))
 
@@ -103,9 +104,16 @@
 (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
 						     (parent t)
 						     (sheet motif-label-pane))
-  (with-accessors ((label gadget-label)) sheet
+  (with-accessors ((label gadget-label)
+		   (alignment gadget-alignment)) sheet
     (values 'tk::xm-label
-	    (and label (list :label-string label)))))
+	    (append
+	     (list :alignment 
+		   (ecase alignment
+		     ((:left nil) :beginning)
+		     (:center :center)
+		     (:right :end)))
+	     (and label (list :label-string label))))))
 
 
 ;;; Push button
@@ -278,10 +286,6 @@
 
 (defclass motif-top-level-sheet (top-level-sheet) ())
 
-(warn "This is really bogus")
-
-(defmethod stream-read-char-no-hang ((x motif-top-level-sheet))
-  nil)
 
 (defmethod add-sheet-callbacks :after ((port motif-port) 
 				       (sheet motif-top-level-sheet)
@@ -347,6 +351,41 @@
 	    (append
 	     (and value `(:value ,value))))))
 
+;;; 
+
+(defclass motif-text-editor (xt-leaf-pane
+			     motif-value-pane 
+			     motif-action-pane
+			     silica::text-editor)
+	  ())
+
+(defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
+						     (parent t)
+						     (sheet motif-text-editor))
+  (with-accessors ((value gadget-value)
+		   (ncolumns silica::gadget-columns)
+		   (nlines silica::gadget-lines)) sheet
+    (values 'tk::xm-text
+	    (append
+	     (and ncolumns (list :columns ncolumns))
+	     (and nlines (list :rows nlines))
+	     (and value `(:value ,value))))))
+
+(defmethod set-mirror-geometry (parent (sheet motif-text-editor) initargs)
+  (multiple-value-bind (left top right bottom)
+      (sheet-actual-native-edges* sheet)
+      (setf (getf initargs :x) (floor left)
+	    (getf initargs :y) (floor top))
+    initargs))
+
+
+(defmethod compose-space ((te motif-text-editor) &key width height)
+  (declare (ignore width height))
+  (let ((sr (call-next-method)))
+    (setq sr (silica::copy-space-requirement sr))
+    (setf (space-requirement-max-width sr) +fill+
+	  (space-requirement-max-height sr) +fill+)
+    sr))
 
 ;;; Toggle button
 
@@ -374,7 +413,7 @@
       (tk::get-values (sheet-mirror gadget) :set)
     (call-next-method)))
 
-(defmethod (setf gadget-value) (nv (gadget motif-toggle-button))
+(defmethod (setf gadget-value) (nv (gadget motif-toggle-button) &key)
   (when (sheet-direct-mirror gadget)
     (tk::set-values (sheet-mirror gadget) :set nv)))
 
diff --git a/tk-silica/xm-menus.lisp b/tk-silica/xm-menus.lisp
index 3a33c8bc57a401ef019ce8a2403b1262553c7e50..c00a9b6a9c7310b6c593901356cd97a9d12f2da5 100644
--- a/tk-silica/xm-menus.lisp
+++ b/tk-silica/xm-menus.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-menus.lisp,v 1.5 92/03/04 16:20:38 cer Exp Locker: cer $
+;; $fiHeader: xm-menus.lisp,v 1.6 92/03/10 15:39:59 cer Exp Locker: cer $
 
 
 (in-package :xm-silica)
@@ -93,17 +93,19 @@
 			       (port-display port)))
 	(declare (ignore ignore win1 win2 x y))
 	(tk::set-values menu :x root-x :y root-y)
-	(tk::manage-child menu)
-	;; Now we have to wait
-	(port-force-output port)
-	(mp::process-wait "Returned value" #'(lambda () 
-					       ;;-- This is to deal
-					       ;;-- with the race
-					       ;;-- condition where
-					       ;;-- the menu go down
-					       ;;-- to quick
-					       (or (not (tk::is-managed-p menu))
-						   value-returned)))
+	(loop
+	  (when value-returned (return nil))
+	  (tk::manage-child menu)
+	  ;; Now we have to wait
+	  (port-force-output port)
+	  (mp::process-wait "Returned value" #'(lambda () 
+						 ;;-- This is to deal
+						 ;;-- with the race
+						 ;;-- condition where
+						 ;;-- the menu go down
+						 ;;-- to quick
+						 (or (not (tk::is-managed-p menu))
+						     value-returned))))
 	;; destroy the menu
 	(tk::unmanage-child menu)
 	(values-list return-value)))))
@@ -113,9 +115,12 @@
     (setf (stream-text-margin menu) 1000)
     (let ((rec (with-output-recording-options (menu :draw nil :record t)
 		 (with-output-to-output-record (menu)
-		   (if presentation-type
-		       (present menu-item presentation-type :stream menu)
-		   (funcall printer menu-item menu))))))
+		   (handler-case
+		       (if presentation-type
+			   (present menu-item presentation-type :stream menu)
+			 (funcall printer menu-item menu))
+		     (error (c)
+		       (write-string "Error in printer" menu)))))))
       (multiple-value-bind
 	  (width height)
 	  (bounding-rectangle-size rec)
diff --git a/tk-silica/xt-frames.lisp b/tk-silica/xt-frames.lisp
index 3ce09e491597e5a23431161f586a00cc5b758f5b..af106403b6a236ef33e2e143d0ccdf2fe4bc88fe 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.lisp,v 1.4 92/02/24 13:06:24 cer Exp $
+;; $fiHeader: xt-frames.lisp,v 1.5 92/03/04 16:20:40 cer Exp Locker: cer $
 
 
 (in-package :xm-silica)
@@ -36,14 +36,31 @@
   (let ((menu-bar (slot-value frame 'menu-bar)))
     (if menu-bar
 	(with-look-and-feel-realization (framem frame)
-	  (vertically ()
-	    (realize-pane 'menu-bar
+	  (let ((mb (realize-pane 'menu-bar
 			  :command-table (if (eq menu-bar t)
 					     (frame-command-table frame)
-					     (find-command-table menu-bar)))
-	    (call-next-method)))
+					   (find-command-table
+					    menu-bar))))
+		(next (call-next-method))
+		(pointer
+		 (if (clim-internals::frame-pointer-documentationp frame)
+		     (setf (slot-value frame 'clim-internals::pointer-documentation-pane)
+		       (realize-pane
+			'clim-internals::pointer-documentation-pane
+			:max-width +fill+
+			;;-- This should be a better value!
+			:height 15)))))
+	    (if pointer
+		(vertically () mb next pointer)
+	      (vertically () mb next))))
 	(call-next-method))))
 
+
+(defmethod clim-internals::port-notify-user ((port xt-port) frame format-string &rest format-arguments)
+  (format excl::*initial-terminal-io* 
+	  "Notify ~a~%" 
+	  (list frame format-string format-arguments)))
+
 ;;;
 
 (defclass presentation-event (event)
diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp
index fe5587cf0b5a8cd5f8c40af2251efff6ef91384f..987d4eeee3672c9e154b1a2dfaa0b25631d6eb78 100644
--- a/tk-silica/xt-graphics.lisp
+++ b/tk-silica/xt-graphics.lisp
@@ -20,7 +20,7 @@ U;; -*- mode: common-lisp; package: xm-silica -*-
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-graphics.lisp,v 1.11 92/03/04 16:20:43 cer Exp Locker: cer $
+;; $fiHeader: xt-graphics.lisp,v 1.12 92/03/09 17:41:28 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -337,7 +337,7 @@ U;; -*- mode: common-lisp; package: xm-silica -*-
       (unless (eq mcr +everywhere+)
 	(setq mcr (transform-region (sheet-device-transformation sheet) mcr))
 	(setq dr (region-intersection dr (bounding-rectangle mcr))))
-      (cond ((eq dr +everywhere+)
+      (cond ((or #+ignore t (eq dr +everywhere+))
 	     (setf (tk::gcontext-clip-mask gc) 
 	       :none))
 	    ((eq dr +nowhere+)
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index 9f724eb5ff3ba7e3517f51744a2e5977002697a7..00789c8bd71c0fec279d5f64c162c72a9e6b5460 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.13 92/03/10 10:12:04 cer Exp Locker: cer $
+;; $fiHeader: xt-silica.lisp,v 1.14 92/03/10 15:40:01 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -394,6 +394,7 @@
       ;;--- We do not want to specify the x,y if this is a top-level
       ;;sheet.
       (unless (typep parent 'tk::shell)
+	;;--floor
 	(setf (getf initargs :x) (floor left)
 	      (getf initargs :y) (floor top)))
       (setf (getf initargs :width) (floor (- right left))
@@ -417,7 +418,8 @@
 (defmethod find-shell-of-calling-frame ((frame application-frame))
   (let (cf)
     (and (setq cf (frame-calling-frame frame))
-	 (sheet-shell (frame-top-level-sheet cf)))))
+	 (setq cf (frame-top-level-sheet cf))
+	 (sheet-shell cf))))
 
 (defmethod find-shell-parent (port sheet)
   (or (and  ;;--- hack alert
diff --git a/tk/graphics.lisp b/tk/graphics.lisp
index c101263fc93a1b3d6e446e600bba2842c7acf787..a59ed0e2b14d9769b2e88c53571520eada96acfb 100644
--- a/tk/graphics.lisp
+++ b/tk/graphics.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: graphics.lisp,v 1.4 92/02/24 13:03:04 cer Exp Locker: cer $
+;; $fiHeader: graphics.lisp,v 1.5 92/03/09 17:40:45 cer Exp Locker: cer $
 
 (in-package :tk)
 
@@ -76,6 +76,11 @@
 		 ;; Degrade to drawing a rectilinear ellipse
 		 (values (truncate (sqrt s-1)) 
 			 (truncate (sqrt s-2)))))))
+    (setq start-angle (round (* start-angle (/ (* 360 64) (* 2 pi)))))
+    (setq end-angle (round (* end-angle (/ (* 360 64) (* 2 pi)))))
+    (if (> end-angle start-angle)
+	(setq end-angle (- end-angle start-angle))
+      (setq end-angle (- start-angle end-angle)))
     (if filled
 	(x11:xfillarc
 	 (object-display drawable)
@@ -85,8 +90,7 @@
 	 (- center-y y-radius)
 	 (* 2 x-radius)
 	 (* 2 y-radius)
-	 0
-	 (* 360 64))
+	 start-angle end-angle)
       (x11:xdrawarc
        (object-display drawable)
        drawable
@@ -95,8 +99,8 @@
        (- center-y y-radius)
        (* 2 x-radius)
        (* 2 y-radius)
-       0
-       (* 360 64)))))
+       start-angle 
+       end-angle))))
 
 (defstub draw-lines (drawable gcontext points &key relative-p fill-p
 			    (shape :complex))
@@ -186,13 +190,23 @@
 (defun draw-string (drawable gc x y string &optional (start 0) end)
   (unless start (setq start 0))
   (unless end (setq end (length string)))
+  #-ignore
   (x11::xdrawstring
    (object-display drawable)
    drawable
    gc
    x y 
    (+ start (string-to-char* string))
-   (- end start)))
+   (- end start))
+  #+ignore
+  (x11:lisp-xdrawstring
+   (object-display drawable)
+   drawable
+   gc
+   x y 
+   string
+   start
+   end))
 
 
 
diff --git a/tk/load-xm.lisp b/tk/load-xm.lisp
index fea0c40751d5dace8d9f6eaa7680bdbccb2c7c4a..5083cb466a225d864cbd9634b5b9cf46a239ff7d 100644
--- a/tk/load-xm.lisp
+++ b/tk/load-xm.lisp
@@ -20,43 +20,27 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: load-xm.lisp,v 1.6 92/02/24 13:03:10 cer Exp Locker: cer $
+;; $fiHeader: load-xm.lisp,v 1.7 92/02/28 09:17:23 cer Exp Locker: cer $
 
 (in-package :tk)
 
-(defmacro symbols-from-file (file)
-  (with-open-file (s file :direction :input)
-    (do ((r nil)
-	 (l (read-line s nil nil) (read-line s nil nil)))
-	((null l)
-	 `(quote ,r))
-      (push l r))))
 
 
-(defun load-undefined-symbols-from-library (what kludges libraries)
-  (setq what (remove-if #'ff::get-entry-point what))
-  (when what
-    (mapc #'foreign-functions:remove-entry-point kludges)
-    (load "" 
-	  :unreferenced-lib-names what
-	  :foreign-files libraries
-	  :print t)))
-
 ;;;; 
 (defvar *libxm-pathname* "/usr/motif/usr/lib/libXm.a")
 (defvar *libxt-pathname* "/usr/motif/usr/lib/libXt.a")
-(defvar *libx11-pathname* "/usr/motif/usr/lib/libX11.a")
+
 
 (defun load-from-xm ()
-  (load-undefined-symbols-from-library
-   (list* "_XCopyGC" (symbols-from-file "misc/undefinedsymbols.motif"))
+  (x11::load-undefined-symbols-from-library
+   (list* "_XCopyGC" (x11::symbols-from-file "misc/undefinedsymbols.motif"))
    '("__unpack_quadruple" 
      "__prod_b10000" 
      "__carry_out_b10000" 
      "__prod_65536_b10000")
    (list *libxm-pathname*
 	 *libxt-pathname*
-	 *libx11-pathname*)))
+	 x11::*libx11-pathname*)))
 
 (load-from-xm)
 
diff --git a/tk/ol-classes.lisp b/tk/ol-classes.lisp
index 80095d67bfc30feb26f3a0091771a3f5738e7572..f3bbf3c5ef540d493f694691786fa0390deaf4f5 100644
--- a/tk/ol-classes.lisp
+++ b/tk/ol-classes.lisp
@@ -20,85 +20,85 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-classes.lisp,v 1.1 92/02/16 20:30:56 cer Exp $
+;; $fiHeader: ol-classes.lisp,v 1.2 92/02/24 13:03:35 cer Exp Locker: cer $
 
 (in-package :tk)
 
-  (defparameter *openlook-classes* '(
-				     ;; Base classes
-				     "_applicationShellWidgetClass"
-				     "_compositeWidgetClass"
-				     "_constraintWidgetClass"
-				     "_coreWidgetClass"
-				     "_objectClass"
-				     "_overrideShellWidgetClass"
-				     "_shellWidgetClass"
-				     "_topLevelShellWidgetClass"
-				     "_transientShellWidgetClass"
-				     "_vendorShellWidgetClass"
-				     "_wmShellWidgetClass"
+(defparameter *openlook-classes* '(
+				   ;; Base classes
+				   "_applicationShellWidgetClass"
+				   "_compositeWidgetClass"
+				   "_constraintWidgetClass"
+				   "_coreWidgetClass"
+				   "_objectClass"
+				   "_overrideShellWidgetClass"
+				   "_shellWidgetClass"
+				   "_topLevelShellWidgetClass"
+				   "_transientShellWidgetClass"
+				   "_vendorShellWidgetClass"
+				   "_wmShellWidgetClass"
 
-				     ;; OpenLook specific classes
-				     ;; Some of these are both gadgets
-				     ;; and widget and I think the
-				     ;; names are the same!
+				   ;; OpenLook specific classes
+				   ;; Some of these are both gadgets
+				   ;; and widget and I think the
+				   ;; names are the same!
 				     
-				     "_abbrevMenuButtonWidgetClass"
-				     "_abbrevStackWidgetClass"
-				     "_arrowWidgetClass"
-				     "_baseWindowShellWidgetClass"
-				     "_bulletinBoardWidgetClass"
-				     "_buttonWidgetClass"
-				     "_buttonGadgetClass"
-				     "_buttonStackWidgetClass"
+				   "_abbrevMenuButtonWidgetClass"
+				   "_abbrevStackWidgetClass"
+				   "_arrowWidgetClass"
+				   "_baseWindowShellWidgetClass"
+				   "_bulletinBoardWidgetClass"
+				   "_buttonWidgetClass"
+				   "_buttonGadgetClass"
+				   "_buttonStackWidgetClass"
 
-				     ;;"_buttonStackGadgetClass"
+				   ;;"_buttonStackGadgetClass"
 
-				     "_captionWidgetClass"
-				     "_checkBoxWidgetClass"
-				     "_controlAreaWidgetClass"
-				     "_eventObjClass"
-				     "_exclusivesWidgetClass"
-				     "_flatCheckBoxWidgetClass"
-				     "_flatExclusivesWidgetClass"
-				     "_flatNonexclusivesWidgetClass"
-				     "_flatWidgetClass"
-				     "_footerPanelWidgetClass"
-				     "_formWidgetClass"
-				     "_helpWidgetClass"
-				     "_listPaneWidgetClass"
-				     "_magWidgetClass"
-				     "_managerWidgetClass"
-				     "_menuShellWidgetClass"
-				     "_menuButtonWidgetClass"
+				   "_captionWidgetClass"
+				   "_checkBoxWidgetClass"
+				   "_controlAreaWidgetClass"
+				   "_eventObjClass"
+				   "_exclusivesWidgetClass"
+				   "_flatCheckBoxWidgetClass"
+				   "_flatExclusivesWidgetClass"
+				   "_flatNonexclusivesWidgetClass"
+				   "_flatWidgetClass"
+				   "_footerPanelWidgetClass"
+				   "_formWidgetClass"
+				   "_helpWidgetClass"
+				   "_listPaneWidgetClass"
+				   "_magWidgetClass"
+				   "_managerWidgetClass"
+				   "_menuShellWidgetClass"
+				   "_menuButtonWidgetClass"
 
-				     ;;"_menuButtonGadgetClass"
+				   ;;"_menuButtonGadgetClass"
 
-				     "_nonexclusivesWidgetClass"
-				     "_noticeShellWidgetClass"
-				     "_oblongButtonWidgetClass"
-				     ;; "_oblongButtonGadgetClass"
-				     "_popupWindowShellWidgetClass"
-				     "_primitiveWidgetClass"
-				     "_pushpinWidgetClass"
-				     "_rectButtonWidgetClass"
-				     "_scrollbarWidgetClass"
-				     "_scrolledWindowWidgetClass"
-				     "_scrollingListWidgetClass"
-				     "_sliderWidgetClass"
-				     "_staticTextWidgetClass"
-				     "_stubWidgetClass"
-				     "_textWidgetClass"
+				   "_nonexclusivesWidgetClass"
+				   "_noticeShellWidgetClass"
+				   "_oblongButtonWidgetClass"
+				   ;; "_oblongButtonGadgetClass"
+				   "_popupWindowShellWidgetClass"
+				   "_primitiveWidgetClass"
+				   "_pushpinWidgetClass"
+				   "_rectButtonWidgetClass"
+				   "_scrollbarWidgetClass"
+				   "_scrolledWindowWidgetClass"
+				   "_scrollingListWidgetClass"
+				   "_sliderWidgetClass"
+				   "_staticTextWidgetClass"
+				   "_stubWidgetClass"
+				   "_textWidgetClass"
 				     
 				     ;;; This two seem to be broken!
-				     ;; "_textEditWidgetClass"
-				     ;;"_textPaneWidgetClass"
+				   ;; "_textEditWidgetClass"
+				   ;;"_textPaneWidgetClass"
 				     
-				     "_compositeWidgetClass"
-				     "_overrideShellWidgetClass"
-				     "_shellWidgetClass"
-				     "_topLevelShellWidgetClass"
-				     "_widgetClass"
-				     "_widgetClassRec"
-				     "_drawAreaWidgetClass"
-				     ))
+				   "_compositeWidgetClass"
+				   "_overrideShellWidgetClass"
+				   "_shellWidgetClass"
+				   "_topLevelShellWidgetClass"
+				   "_widgetClass"
+				   "_widgetClassRec"
+				   "_drawAreaWidgetClass"
+				   ))
diff --git a/tk/ol-init.lisp b/tk/ol-init.lisp
index dfd5a454bf4f38a95be81c75817df79caaab47da..e9ba1b398781174c552939775de9f533a098a8d5 100644
--- a/tk/ol-init.lisp
+++ b/tk/ol-init.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-init.lisp,v 1.6 92/02/24 13:03:42 cer Exp Locker: cer $
+;; $fiHeader: ol-init.lisp,v 1.7 92/03/09 17:40:52 cer Exp Locker: cer $
 
 
 (in-package :tk)
@@ -72,6 +72,7 @@
 
 (unless *ol-done*
   (ol-initialize)
+  (xt-initialize)
   (define-toolkit-classes *openlook-classes*)
   (setq *ol-done* t))
 
diff --git a/tk/xm-init.lisp b/tk/xm-init.lisp
index e265431384704f760a3b83dcc0ba31847aa1285c..6e835b7f21a647e65958b14a99b33876a58a9bac 100644
--- a/tk/xm-init.lisp
+++ b/tk/xm-init.lisp
@@ -20,16 +20,15 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-init.lisp,v 1.4 92/02/16 20:55:08 cer Exp $
+;; $fiHeader: xm-init.lisp,v 1.5 92/02/24 13:04:03 cer Exp Locker: cer $
 
 
 (in-package :tk)
 
 (defvar *xm-done* nil)
 
-(warn "This bites")
-
 (unless *xm-done*
+  (xt-initialize)
   (define-toolkit-classes *motif-classes*)
   (setq *xm-done* t))
 
diff --git a/tk/xt-init.lisp b/tk/xt-init.lisp
index bd41af2f3f15bfd3cd3566eba96d65461ea3a28f..3bdc3c4407fba13094e21e0afbb8e5eadc62506c 100644
--- a/tk/xt-init.lisp
+++ b/tk/xt-init.lisp
@@ -20,14 +20,15 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-init.lisp,v 1.1 92/02/16 20:31:00 cer Exp $
+;; $fiHeader: xt-init.lisp,v 1.2 92/02/24 13:04:16 cer Exp Locker: cer $
 
 
 (in-package :tk)
 
 (defvar *xt-done* nil)
 
-(unless *xt-done*
-  (toolkit-initialize)
-  (define-toolkit-classes *intrinsic-classes*)
-  (setq *xt-done* t))
+(defun xt-initialize ()
+  (unless *xt-done*
+    (toolkit-initialize)
+    (define-toolkit-classes *intrinsic-classes*)
+    (setq *xt-done* t)))
diff --git a/utils/excl-verification.lisp b/utils/excl-verification.lisp
index 236816a42a1271fca7ca5c57a16a40c35563a815..1ff2e04cd506072e85e5500765c5aeef7b66abbf 100644
--- a/utils/excl-verification.lisp
+++ b/utils/excl-verification.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: excl-verification.lisp,v 1.4 92/02/24 13:05:36 cer Exp $
+;; $fiHeader: excl-verification.lisp,v 1.5 92/03/10 10:11:51 cer Exp Locker: cer $
 
 (in-package :sys)
 
@@ -31,5 +31,5 @@ You do not have patches ~{~S ~}"
 	   dont-have)))
 
 (si::rcsnote
- "CLIM 2.0"
+ "CLIM 2.0.alpha.0"
  "$fiHeader: ")
diff --git a/utils/packages.lisp b/utils/packages.lisp
index 1872248945b2a85d220d7910e76ae04a18840783..bb4dd3802715c91e9fe755a95082cebfebcc4e9d 100644
--- a/utils/packages.lisp
+++ b/utils/packages.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: packages.lisp,v 1.4 92/02/24 13:05:46 cer Exp $
+;; $fiHeader: packages.lisp,v 1.7 92/03/10 10:11:54 cer Exp Locker: cer $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user)
 
@@ -1745,6 +1745,7 @@
     pointer-event-y
     pointer-exit-event
     pointer-motion-event
+    port-notify-user
     poll-pointer
     port
     port-keyboard-input-focus
@@ -2514,6 +2515,8 @@
     pane-frame
     pane-needs-redisplay
     panes-need-redisplay
+    pane-viewport
+    pane-viewport-region
     read-frame-command
     reconfigure-frame
     redisplay-frame-command-menu
@@ -2556,6 +2559,7 @@
     scrolling
     spacing
     tabling
+    text-editor
     text-field
     text-stream-pane
     top-level-sheet
@@ -2572,12 +2576,14 @@
     disarmed-callback
     drag-callback
     gadget
+    gadget-alignment
     gadget-client
     gadget-id
     gadget-indicator-type
     gadget-label
     gadget-orientation
     gadget-value
+    label-pane
     menu-bar
     note-gadget-activated
     note-gadget-deactivated
@@ -3240,7 +3246,6 @@
     intern-text-style
     invoke-callback-function
     label-button-pane
-    label-pane
     labelled-gadget
     line-editor-pane
     list-pane
@@ -3265,8 +3270,6 @@
     one-of-pane
     outlined-pane
     pane-scroller
-    pane-viewport
-    pane-viewport-region
     parse-gesture-spec
     permanent-medium-sheet-output-mixin
     pointer-press-event
diff --git a/xlib/ffi.lisp b/xlib/ffi.lisp
index 530668fc29f268a9f01ed8d58c1769502e112dc3..5cb7793bbaa89b20fd26e1984e0a589d0af3abd5 100644
--- a/xlib/ffi.lisp
+++ b/xlib/ffi.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ffi.lisp,v 1.6 92/02/24 13:06:33 cer Exp Locker: cer $
+;; $fiHeader: ffi.lisp,v 1.7 92/03/09 17:41:32 cer Exp Locker: cer $
 
 (in-package :x11)
 
@@ -86,9 +86,9 @@
 	      (error ":overlays used in a way we cannot handle")))))
      (defmacro ,(fintern "~A~A" 'make- name) ()
        #+ignore
-       (excl::malloc ,(ff::cstruct-property-length (ff::cstruct-prop name)))
+       `(excl::malloc ,,(ff::cstruct-property-length (ff::cstruct-prop name)))
        #-ignore
-       (ff::make-cstruct ',name))))
+       `(ff::make-cstruct ',',name))))
 	  
 
 (defun trans-slot-type (type)
diff --git a/xlib/xlib-funs.lisp b/xlib/xlib-funs.lisp
index 0853e8045ab7fefd409d5109917860bfacfcb749..0a571a42673490d7509eed3ed76923d9e7550d37 100644
--- a/xlib/xlib-funs.lisp
+++ b/xlib/xlib-funs.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;;; $fiHeader$
+;;; $fiHeader: xlib-funs.lisp,v 1.1 92/03/06 17:07:01 cer Exp Locker: cer $
 
 (in-package :x11)
 
@@ -1769,7 +1769,7 @@
    (gc gc)
    (x fixnum-int)
    (y fixnum-int)
-   (string :simple-string)
+   (string (:pointer char))
    (start fixnum-int)
    (end fixnum-int))