diff --git a/ChangeLog.n b/ChangeLog.n
index 509414b7958318f8980db15dc10d06331a0b1402..aeda8cc017e7e1ad4a053655ea47d5196afe21e5 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -1,3 +1,78 @@
+from cer: Fri Sep 17 12:03:17 PDT 1993
+
+Makefile.defs			Replaced /vapor by /net/vapor, Added PRODUCT_SRC_FILES
+Makefile.generic		Used PRODUCT_SRC_FILES in echo rule
+Makefile.sun4.motif-1.1.4	Replaced /vapor by /net/vapor
+clim/accept-values.lisp		Used destroy-frame instead of disown-frame
+				Bound (*editting-field-p* nil)
+clim/command-processor.lisp	Used discard-keystroke-gesture in menu-command-parser
+clim/completer.lisp		Fixed completer to handle :eof better
+clim/dragging-output.lisp 	Indentation
+clim/frames.lisp		Frame max size is now the size of the graft
+clim/graph-formatting.lisp	Implemented grapher-fake-object for use in grapher-made nodes.
+				Made off/on-page connectors use them
+clim/incremental-redisplay.lisp	Debugging statements and declare ignores.
+clim/output-protocol.lisp	declare ignores
+clim/pixmap-streams.lisp	width/height check for pixmaps
+clim/r-tree.lisp		delete-output-record failing test.
+clim/recording-protocol.lisp	Establish clipping region for stream-replay
+clim/standard-types.lisp	simple-lisp-object-parser and keyword parser changes.
+clim/view-defs.lisp		Added iconic view
+climtoys/booch.lisp		Cloud-line intersection code.
+climtoys/draw-sheets.lisp	print-widget-hierarchy, print-sheet-hierarchy code
+climtoys/ib.lisp		display-classes palette uses updating-output
+				moved wire code to ibparts.lisp
+climtoys/pi.lisp		Has set wt::*c* menu item
+climtoys/sysdcl.lisp		Added ibparts.lisp
+demo/bitmap-editor.lisp		Removed copyright, Renamed color -> color-frame
+demo/color-editor.lisp		Renamed color -> color-frame
+demo/ico.lisp			Added scroll-bars nil, max-height/min-width :compute
+demo/navfun.lisp		removed iconic view
+demo/palette.lisp		Removed copyright
+demo/plot.lisp			Removed copyright
+demo/process-browser.lisp	Removed copyright
+hpgl/pkg.lisp			Package locking
+misc/train.lisp			Various debugging output
+postscript/pkgdcl.lisp		Package locking
+silica/framem.lisp		Added declare ignore
+silica/medium.lisp		Added declare ignore
+silica/mirror.lisp		Update port miror->sheet table appropriately
+test/test-clim-tests.lisp	Fixed undefined variable
+test/test-clim.lisp		Added Accept-string test
+test/test-demos.lisp		Expanded tests for demos
+test/test-driver.lisp		Commented output debugging into
+				Look for presentations
+				Added cannot-find-presentation-error condition
+				Change gadget-value, activate-gadget code
+				menu manipulation code
+				with-waiting macro
+test/test-suite.lisp		More menu tests
+tk/event.lisp			Split wait-for-event for efficiency
+tk/gcontext.lisp		Eliminated allocation
+tk/graphics.lisp		noted allocation errors
+tk/make-widget.lisp		Eliminated writer methods
+tk/pkg.lisp			package locking
+tk/widget.lisp			Added counters
+tk/xlib.lisp			pixmap width/height test
+tk/xm-funs.lisp			specified :callback nil
+tk-silica/image.lisp		Support for reading pixmaps without palette
+tk-silica/last.lisp		
+tk-silica/ol-gadgets.lisp	Fixed radio/check box geometry calculation
+tk-silica/ol-silica.lisp	Warning about OPENWINHOME
+tk-silica/pkg.lisp		package locking
+tk-silica/xm-frames.lisp	Use appropriate :packing in menu
+tk-silica/xm-gadgets.lisp	Added missing :item-count in list-pane writer
+tk-silica/xm-silica.lisp	Added commented out shell destroyer
+tk-silica/xt-frames.lisp		
+tk-silica/xt-graphics.lisp	Added rounding error notes
+tk-silica/xt-silica.lisp	Updating port mirror->sheet mapping
+				backing store is now when-mapped
+utils/clim-streams.lisp		Declare *original-stream*
+utils/clos-patches.lisp		
+utils/packages.lisp		implementation-package stuff for package locking
+utils/processes.lisp		
+
+
 from colin: Fri Sep 17 11:34:06 PDT 1993
 
 demo/demo-driver.lisp
diff --git a/Makefile.defs b/Makefile.defs
index f083f5a51540e9484201ffb515b4cbe0528c9ee5..c426ed3c832a8d3a20a3658c97ef5c38f8510147 100644
--- a/Makefile.defs
+++ b/Makefile.defs
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.defs,v 1.18 1993/08/31 04:53:51 layer Exp $
+# $fiHeader: Makefile.defs,v 1.20 1993/09/17 06:34:06 duane Exp $
 #
 #  Makefile.defs for CLIM 2.0
 #
@@ -89,6 +89,11 @@ SRC_FILES = */*.lisp *.lisp Makefile Makefile.* misc/make-stub-file \
 	    xlib/xlibsupport.c misc/MyDrawingA*.[hc] misc/olsupport.c \
 	    misc/clos-preload.cl misc/xtsupport.c misc/climgccursor.c
 
+# These are the files that make up the source code product.
+
+PRODUCT_SRC_FILES = sys/*.lisp utils/*.lisp  silica/*.lisp clim/*.lisp \
+	demo/*.lisp test/test-suite.lisp
+
 DEST=/dev/null
 
 CL_SRC=/usr/tech/cer/cl/src
@@ -98,7 +103,7 @@ OPENWINHOME=/usr/openwin-3.0
 DEBUGLIB=
 XLIBS= $(XTLIB) $(XLIB)
 
-OLCOPYLIB=/vapor/x11/olit-3.0/lib3/sun4
+OLCOPYLIB=/net/vapor/x11/olit-3.0/lib3/sun4
 OLXLIBS=$(OLCOPYLIB)/libXt.a $(OLCOPYLIB)/libX11.a
 LIBXOL=$(OLCOPYLIB)/libXol.a
 LIBXOL_d=$(LIBXOL)
diff --git a/Makefile.generic b/Makefile.generic
index c5e04619373e09265baac70a53473fe224227034..991284cacf09ef251b504411645cc074c7bea501 100644
--- a/Makefile.generic
+++ b/Makefile.generic
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.generic,v 1.17 1993/07/29 20:51:17 layer Exp $
+# $fiHeader: Makefile.generic,v 1.20 1993/09/17 06:34:09 duane Exp $
 #
 #  Makefile.generic for CLIM 2.0
 #
@@ -248,7 +248,7 @@ cleanobjs:
 clean:
 	find . -name '*.fasl' -print | xargs rm -f
 	rm -f $(CLIMFASLS) $(CLIMOBJS) *.o \
-	  	stub-motif.c stub-olit.c stub-xt.c stub-x.c slim slim-small
+	  	stub-motif.c stub-olit.c stub-xt.c stub-x.c slim slim.ol slim-small
 	rm -f *.z *.Z *.gz *.ilt
 
 cheapclean:
@@ -307,7 +307,7 @@ link-objects	:
 link-motif-libraries:	link-objects
 
 echo_src_files:
-	@ls $(SRC_FILES) | cat
+	@echo $(PRODUCT_SRC_FILES)
 
 makeclimobjs: $(CLIMOBJS)
 
diff --git a/Makefile.sun4.motif-1.1.4 b/Makefile.sun4.motif-1.1.4
deleted file mode 100644
index aec0ab1b878e4cd19377e6400d57138571a281d1..0000000000000000000000000000000000000000
--- a/Makefile.sun4.motif-1.1.4
+++ /dev/null
@@ -1,20 +0,0 @@
-# $fiHeader: Makefile.sun4.motif-1.1.4,v 1.2 93/04/07 09:06:25 cer Exp $
-#
-#  Makefile.sun4 for CLIM 2.0
-#
-
-include Makefile.defs
-
-Makefile=Makefile.sun4.motif-1.1.4
-
-MOTIFLIB=/x11/R4/sun4-lib/libXm$(DEBUGLIB).a
-MOTIFLIB_d=/x11/R4/sun4-lib/libXm_d.a
-XLIB= /x11/R4/sun4-lib/libX11$(DEBUGLIB).a 
-XTLIB=/x11/R4/sun4-lib/libXt$(DEBUGLIB).a
-XINCLUDES=-I/x11/motif-1.1/lib
-XTSUPPORTINCLUDES=-I/x11/R4/src/mit/lib/Xt
-
-OLXLIB= /vapor/x11/olit-3.0/lib/libX11.a
-OLXTLIB=/vapor/x11/olit-3.0/lib/libXt.a
-
-include Makefile.generic
diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index 79d4637147d13d95ec7331619d015dbc23074db1..681be9f9cff2a12e2c637a252241c20dea9fad7a 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.67 1993/07/27 01:38:07 colin Exp $
+;; $fiHeader: accept-values.lisp,v 1.68 1993/08/12 16:02:56 cer Exp $
 
 (in-package :clim-internals)
 
@@ -390,7 +390,7 @@
 	       (let ((*avv-calling-frame* *application-frame*))
 		 (run-frame-top-level frame))
 	     ;; Flush it so the GC can get rid of it
-	     (disown-frame (frame-manager frame) frame)))
+	     (destroy-frame frame)))
 	 (using-resource (avv-stream accept-values-stream (or the-own-window stream)
 				     :align-prompts align-prompts)
 	   (let ((frame (make-application-frame (or frame-class 'accept-values)
@@ -442,7 +442,8 @@
 	   (own-window-bottom-margin (pop properties))
 	   (view 
 	    (or view
-		(frame-manager-dialog-view (frame-manager frame)))))
+		(frame-manager-dialog-view (frame-manager frame))))
+	   (*editting-field-p* nil))
       (letf-globally (((stream-default-view stream) view)
 		      ((stream-read-gesture-cursor-state stream) nil))
 	(labels ((run-continuation (stream avv-record)
diff --git a/clim/command-processor.lisp b/clim/command-processor.lisp
index 0d09e100a9ec1cfc661d315e9da9319592fc31ab..643697ebce7255465ad84b8296dcdf94f94720ff 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.21 93/03/19 09:43:16 cer Exp $
+;; $fiHeader: command-processor.lisp,v 1.22 1993/07/27 01:38:27 colin Exp $
 
 (in-package :clim-internals)
 
@@ -472,15 +472,15 @@
 					 (values command
 						 command-type)))))
 				 (beep stream)
-				 ;;--- Nasty hack
-				 (when (typep stream 'input-editing-stream-mixin)
-				   (let ((input-buffer
-					  (input-editor-buffer stream)))
-				     (ie-rub-del stream input-buffer -1)))))
-			     (let ((token (read-token stream :click-only t :timeout timeout)))
-			       (if (eq token :timeout)
-				   (return-from menu-command-parser nil)
-				   token)))
+				 (discard-keystroke-gesture stream)))
+			   (loop 
+			     (multiple-value-bind (keystroke numeric-arg)
+				 (read-gesture :stream stream :timeout timeout)
+			       (declare (ignore keystroke))
+			       (when (eq numeric-arg :timeout)
+				 (return-from menu-command-parser nil))
+			       (beep stream)
+			       (discard-keystroke-gesture stream))))
 		       (t (values object type)))
 		    (setq first-arg nil)))
 		(menu-delimiter (stream args-to-go)
@@ -492,6 +492,14 @@
 		 command-table #'menu-parser #'menu-delimiter stream)))
 	 (t (values command type))))))
 
+
+(defun discard-keystroke-gesture (stream)
+  ;;--- Nasty hack
+  (when (typep stream 'input-editing-stream-mixin)
+    (let ((input-buffer
+	   (input-editor-buffer stream)))
+      (ie-rub-del stream input-buffer -1))))
+
 (defun menu-read-remaining-arguments-for-partial-command
        (partial-command command-table stream start-location &key for-accelerator)
   (declare (ignore start-location for-accelerator))
diff --git a/clim/completer.lisp b/clim/completer.lisp
index e8e0c4ff6b6a70b1a986fdb63187e4a544363133..48258ed1c84eb5cbe191f990897bc466656dc58b 100644
--- a/clim/completer.lisp
+++ b/clim/completer.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: completer.lisp,v 1.14 1993/07/27 01:38:33 colin Exp $
+;; $fiHeader: completer.lisp,v 1.15 1993/09/17 00:20:00 colin Exp $
 
 (in-package :clim-internals)
 
@@ -138,7 +138,10 @@
 	     (when (input-editing-stream-p stream)
 	       (rescan-if-necessary stream))
 	     (signal 'empty-completion-error
-		     :format-string "Attempting to complete the null string"))
+		     :format-string "Attempting to complete the null string")
+	     (when (eq ch *end-of-file-marker*)
+	       (error 'empty-completion-error
+		       :format-string "Attempting to complete the null string")))
 
 	   (cond ((member completion-mode '(:help :possibilities :apropos-possibilities))
 		  ;; Since we've asked the input editor not to do this,
@@ -193,7 +196,7 @@
 	   ;; Decide whether or not to return, remembering that
 	   ;; we might have called the completer.
 	   (when return
-	     (when (or (member completion-type '(nil unique left-substring))
+ 	     (when (or (member completion-type '(nil unique left-substring))
 		       allow-any-input)
 	       ;; Leave the last delimiter for our caller
 	       (when (eq unread t)
@@ -203,7 +206,9 @@
 	       (unless (stream-rescanning-p stream)
 		 (replace-input stream stuff-so-far :buffer-start location))
 	       (return-from complete-input
-		 (values answer-object t (evacuate-temporary-string stuff-so-far)))))
+		 (values answer-object t (evacuate-temporary-string stuff-so-far))))
+	     (when (eq ch *end-of-file-marker*)
+	       (error "Eof when encountered when trying to complete")))
 
 	   ;; Not returning yet, but update the input editor's buffer anyway
 	   (unless (stream-rescanning-p stream)
diff --git a/clim/dragging-output.lisp b/clim/dragging-output.lisp
index bd61c79d617477eb068632b0e33f1a5d3c7ce765..86fed2ea090ad2cd1cf94cd1798da5fd910f0279 100644
--- a/clim/dragging-output.lisp
+++ b/clim/dragging-output.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: dragging-output.lisp,v 1.10 92/11/19 14:17:30 cer Exp $
+;; $fiHeader: dragging-output.lisp,v 1.11 1993/07/27 01:39:12 colin Exp $
 
 (in-package :clim-internals)
 
@@ -71,8 +71,8 @@
 		     output-record (- x delta-x) (- y delta-y))
 		   (when parent
 		     (add-output-record output-record parent)
-		     (tree-recompute-extent output-record))
-		   (replay-output-record output-record stream nil x-offset y-offset))
+		     (tree-recompute-extent output-record)
+		     (replay-output-record output-record stream nil x-offset y-offset)))
 		 (return-from drag-output-record
 		   (values x y delta-x delta-y))))
 	  (declare (dynamic-extent #'finish))
diff --git a/clim/frames.lisp b/clim/frames.lisp
index 9d5085d5825a0274ec24df59f1a24705720bd2ba..3a2635a762c0286340fed26758a7b8113b15223c 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.71 1993/07/27 01:39:24 colin Exp $
+;; $fiHeader: frames.lisp,v 1.72 1993/09/07 21:45:43 colin Exp $
 
 (in-package :clim-internals)
 
@@ -526,7 +526,7 @@
   `(multiple-value-bind (graft-width graft-height)
        (bounding-rectangle-size ,graft)
      ;;--- This fudge factor stuff looks dubious  --SWM
-     (let ((fudge-factor #+Allegro 0.9 #-Allegro 1))
+     (let ((fudge-factor #+ignore 0.9 #-ignore 1))
        (minf-or ,width (* graft-width fudge-factor))
        (minf-or ,height (* graft-height fudge-factor)))))
 
@@ -538,8 +538,8 @@
       (unless (and width height)
 	(let ((sr (compose-space panes)))
 	  (setq width  (or width (space-requirement-width sr))
-		height (or height (space-requirement-height sr)))))
-      (limit-size-to-graft width height (graft frame))
+		height (or height (space-requirement-height sr))))
+	(limit-size-to-graft width height (graft frame)))
 
       ;;--- Don't bother with this if the size didn't change?
       (let ((top-sheet (or (frame-top-level-sheet frame) panes)))
@@ -549,6 +549,7 @@
 	      top-sheet (bounding-rectangle-size top-sheet)) 
 	  (resize-sheet top-sheet width height))))))
 
+
 (defvar *frame-layout-changing-p* nil)
 
 (defmethod (setf frame-current-layout) (layout (frame standard-application-frame))
diff --git a/clim/graph-formatting.lisp b/clim/graph-formatting.lisp
index dbebdfed0b465bb76493f0b1a6ab264267b4711b..a2067dc09fcad9918008459360eb1d131d9596cb 100644
--- a/clim/graph-formatting.lisp
+++ b/clim/graph-formatting.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graph-formatting.lisp,v 1.30 93/04/23 09:17:29 cer Exp $
+;; $fiHeader: graph-formatting.lisp,v 1.31 1993/07/22 15:37:56 cer Exp $
 
 (in-package :clim-internals)
 
@@ -550,6 +550,10 @@ circular graphs without accounting for this case.
     ()
   (:default-initargs :object nil))
 
+(defclass grapher-fake-object ()
+  ((data :initarg :data :reader grapher-fake-object-data)))
+
+
 
 (defmethod generate-graph-nodes ((graph directed-graph-output-record) stream
 				 root-objects object-printer inferior-producer
@@ -649,6 +653,9 @@ circular graphs without accounting for this case.
 				      (let* ((id (1+ (length connectors-in)))
 					     (rec (with-new-output-record
 						      (stream 'graph-node-connector-in-output-record nil
+							      :object
+							      (make-instance 'grapher-fake-object
+									     :data `(:in-connector ,node ,child))
 						       :connector-id id)
 						    (funcall offpage-connector-in-printer
 							     stream id))))
@@ -661,6 +668,8 @@ circular graphs without accounting for this case.
 		       (setf (car c)
 			     (with-new-output-record
 				 (stream 'graph-node-connector-out-output-record nil
+					 :object (make-instance 'grapher-fake-object
+						  :data `(:out-connector ,node ,child))
 				  :connector-id id)
 			       (funcall offpage-connector-out-printer stream id))))
 		     (break-cycles child (cons node path)))))))
@@ -703,7 +712,9 @@ circular graphs without accounting for this case.
 					 nil)))
 			   (setf (graph-node-children filler) (list child)
 				 (graph-node-parents filler)  (list node)
-				 (graph-node-object filler) `(:filler ,filler ,(graph-node-object node))
+				 (graph-node-object filler) 
+				 (make-instance 'grapher-fake-object
+						:data `(:filler ,filler ,(graph-node-object node)))
 				 (car c) filler
 				 (graph-node-generation filler) gen1)
 			   (traverse filler))
@@ -714,38 +725,6 @@ circular graphs without accounting for this case.
 
 ;;
 
-;(defun filler-node-p (object)
-;  (and (consp object) (eq (car object) :filler)))
-
-;(defun filler-edge-p (from to)
-;  (or (filler-node-p from)
-;      (filler-node-p to)))
-;
-;(defun decode-filler-node (object)
-;  (labels ((decode-from (object)
-;	     (if (filler-object-p object)
-;		 (decode-from (second object))
-;	       object))
-;	   (decode-to (object)
-;	     (if (filler-object-p object)
-;		 (decode-to (third object))
-;	       object)))
-;    (values (decode-from object) (decode-to object))))
-;
-;(defun decode-filler-edge (from to)
-;  (labels ((decode-from (object)
-;	     (if (filler-object-p object)
-;		 (decode-from (second object))
-;	       object))
-;	   (decode-to (object)
-;	     (if (filler-object-p object)
-;		 (decode-to (third object))
-;	       object)))
-;    (values (filler-node-p from)
-;	    (decode-from from) 
-;	    (filler-node-p to)
-;	    (decode-to to))))
-
 ;;
 
 (defstruct (generation-descriptor (:conc-name generation-) (:type list))
@@ -853,7 +832,10 @@ circular graphs without accounting for this case.
 				       (graph-node-children new) (graph-node-children node)
 				       (graph-node-parents new) (graph-node-parents node)
 				       (graph-node-parents child) (list new)
-				       (graph-node-object new) `(:filler ,new ,(graph-node-object node))
+				       (graph-node-object new) 
+				       (make-instance
+					'grapher-fake-object
+					:data `(:filler ,new ,(graph-node-object node)))
 				       (car c) new)))))
 			 (map nil #'replace-filler-nodes children))))
 		    (declare (dynamic-extent #'replace-filler-nodes))
diff --git a/clim/incremental-redisplay.lisp b/clim/incremental-redisplay.lisp
index ebe649bd3f554e788199b5ea44d0df9ae601388e..fb01680569c88e37754ffb31aedbdf26c73523cc 100644
--- a/clim/incremental-redisplay.lisp
+++ b/clim/incremental-redisplay.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: incremental-redisplay.lisp,v 1.20 93/04/27 14:35:34 cer Exp $
+;; $fiHeader: incremental-redisplay.lisp,v 1.21 1993/07/27 01:39:50 colin Exp $
 
 (in-package :clim-internals)
 
@@ -446,6 +446,7 @@
 		      (old-x-offset (coordinate 0)) (old-y-offset (coordinate 0)))
   (declare (type coordinate x-offset y-offset old-x-offset old-y-offset))
   (declare (values erases moves draws erase-overlapping move-overlapping))
+  (declare (ignore check-overlapping))
   #+ignore (when (eq record wt::*c*) (break "found it"))
   (let ((erases nil)
 	(moves nil)
@@ -503,6 +504,7 @@
 	      (t
 	       (when (displayed-output-record-p record)
 		 ;; It's a displayed output record element, erase and redraw it.
+		 #+ignore (format excl:*initial-terminal-io* "erase1 ~S~%" record)
 		 (erase record old-bounding-rectangle)
 		 (draw record (bounding-rectangle record)))
 	       (when (output-record-p record)
@@ -514,6 +516,7 @@
 		       (output-record-old-start-cursor-position record)
 		     (declare (type coordinate o-start-x o-start-y))
 		     (dolist (child (output-record-old-children record))
+		       #+ignore (break  "erase2 ~S~%" child)
 		       (erase child (bounding-rectangle-shift-position
 				      child o-start-x o-start-y)))
 		     (let ((x-offset (+ x-offset start-x))
@@ -658,7 +661,7 @@
 	       (with-bounding-rectangle* (left top right bottom) rectangle
 		 (translate-coordinates xoff yoff left top right bottom)
 		 (draw-rectangle* stream left top right bottom
-				  :ink #+ignore +red+ +background-ink+  :filled t)
+				  :ink  #+ignore +red+  +background-ink+  :filled t)
 		 #+ignore
 		 (break "erase ~S" (list left top right bottom))))
 	     (replay-record (record stream region)
@@ -670,11 +673,15 @@
 	;; (format excl:*initial-terminal-io* "Doing erases~%")
 	(dolist (erase erases)
 	  (let ((region (second erase)))
-	    (erase-rectangle stream region)))
+	    (erase-rectangle stream region)
+	    #+ignore
+	    (break "erase erase~S" erase)))
 	;; (format excl:*initial-terminal-io* "Doing erases for moves~%")
 	(dolist (move moves)
 	  (let ((erase (second move)))
-	    (erase-rectangle stream erase)))
+	    (erase-rectangle stream erase)
+	    #+ignore
+	    (break "erase move ~S" move)))
 	;; (format excl:*initial-terminal-io* "Doing moves~%")
 	(dolist (move moves)
 	  (let ((record (first move))
@@ -752,6 +759,7 @@
 			  (make-point x y)))
 		      (old-child-extent
 			(output-record-old-bounding-rectangle child)))
+  #---ignore (declare (ignore old-child-extent old-child-position mode))
   #---ignore
   nil
   #+++ignore ;; until PROPAGATE-OUTPUT-RECORD-CHANGES is implemented.
@@ -809,6 +817,8 @@
 		      erases moves draws erase-overlapping move-overlapping)
   (declare (values new-mode new-erases new-moves new-draws
 		   new-erase-overlapping new-move-overlapping))
+  (declare (ignore move-overlapping erase-overlapping draws 
+		   moves erases old-child-extent old-child-position)) ;--- Why
   ;; If :DELETE, and deleted all children, delete self,
   ;; if :DELETE and there's anyone past the extent, move them.
   ;; if :ADD or :CHANGE, and extent grew, and there's anyone past the extent, move them.
diff --git a/clim/output-protocol.lisp b/clim/output-protocol.lisp
index c2344715bce0204ee409c368c68b95c8dce2e1ca..3e6665112c3f70ebc7108061abcf399d5c501b77 100644
--- a/clim/output-protocol.lisp
+++ b/clim/output-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: output-protocol.lisp,v 1.38 1993/06/04 16:06:23 cer Exp $
+;; $fiHeader: output-protocol.lisp,v 1.39 1993/09/07 21:46:04 colin Exp $
 
 (in-package :clim-internals)
 
@@ -541,6 +541,7 @@
 (defmethod stream-move-for-line-height-change ((stream output-protocol-mixin)
 					       movement old-height cursor-x cursor-y)
   ;;--- This doesn't appear to work yet, and it's "not cheap"
+  #---ignore (declare (ignore movement old-height cursor-x cursor-y))
   #+++ignore (copy-area (sheet-medium stream)
 			0 cursor-y cursor-x old-height
 			0 (+ cursor-y movement))
diff --git a/clim/pixmap-streams.lisp b/clim/pixmap-streams.lisp
index 8165a25dfa3b0dbb2f1bd3b2067f9d70b74f8181..8b8d5fe1cc1b790d9b2c0b195124455d497725b6 100644
--- a/clim/pixmap-streams.lisp
+++ b/clim/pixmap-streams.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: pixmap-streams.lisp,v 1.20 1993/07/30 23:57:59 colin Exp $
+;; $fiHeader: pixmap-streams.lisp,v 1.21 1993/08/12 16:03:11 cer Exp $
 
 (in-package :clim-internals)
 
@@ -82,6 +82,8 @@
 			  (write-string "Error in printer" menu)))))))
       (multiple-value-bind (width height)
 	  (bounding-rectangle-size record)
+	(assert (and (plusp width) (plusp height))
+	    () "Width and height of output must be greater than zero")
 	(with-output-to-pixmap (stream associated-window :width width :height height)
 	  (when text-style
 	    (setf (medium-default-text-style stream) text-style))
diff --git a/clim/r-tree.lisp b/clim/r-tree.lisp
index 8e3bcde6708d0f4cfdff9902a52713f2549f293e..6277f950b3c10e5e551c887a2587e9cf9aef830f 100644
--- a/clim/r-tree.lisp
+++ b/clim/r-tree.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: r-tree.lisp,v 1.2 92/10/02 15:19:57 cer Exp $
+;; $fiHeader: r-tree.lisp,v 1.3 1993/07/27 01:40:52 colin Exp $
 
 (in-package :clim-internals)
 
@@ -656,8 +656,13 @@
 (defmethod delete-output-record (child (record r-tree-output-record)
 				 &optional (errorp t))
   (with-slots (root) record
-    (let ((new-root (r-tree-delete root child)))
-      (setf root new-root))))
+    (multiple-value-bind (new-root foundp) 
+	(r-tree-delete root child)
+      (cond (foundp 
+	     (setf root new-root))
+	    (errorp
+	     (error "The output record ~S was not found in ~S"
+		    child record))))))
 
 (defmethod map-over-output-records-overlapping-region
 	   (function (record r-tree-output-record) region
diff --git a/clim/recording-protocol.lisp b/clim/recording-protocol.lisp
index 7efbe69e56f31783e6528b5bedb8fd6b6144fbd4..a437ce89896840d73f6fe60d108cd500036024a8 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.34 1993/05/25 20:41:01 cer Exp $
+;; $fiHeader: recording-protocol.lisp,v 1.35 1993/07/27 01:40:59 colin Exp $
 
 (in-package :clim-internals)
 
@@ -1143,11 +1143,12 @@
     (with-slots (output-record text-output-record record-p) stream
       (when (or output-record text-output-record)
 	(setq region (normalize-replay-region region stream))
-	(letf-globally ((record-p nil))
-	  (when output-record
-	    (replay output-record stream region))
-	  (when text-output-record
-	    (replay text-output-record stream region)))))))
+	(clim-utils::with-drawing-options (stream :clipping-region region)
+	  (letf-globally ((record-p nil))
+	    (when output-record
+	      (replay output-record stream region))
+	    (when text-output-record
+	      (replay text-output-record stream region))))))))
 
 (defmethod erase-output-record (record (stream output-recording-mixin) &optional (errorp t))
   (macrolet ((draw-it ()
diff --git a/clim/standard-types.lisp b/clim/standard-types.lisp
index 9c0e2fbebbb18db04d83ceb525277fcc4466d433..2eac19ed0395ba00859694ff726647a513692cf7 100644
--- a/clim/standard-types.lisp
+++ b/clim/standard-types.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: standard-types.lisp,v 1.28 1993/05/13 16:23:22 cer Exp $
+;; $fiHeader: standard-types.lisp,v 1.29 1993/05/25 20:41:05 cer Exp $
 
 (in-package :clim-internals)
 
@@ -56,13 +56,14 @@
 (define-presentation-method accept ((type symbol) stream (view textual-view) &key)
   (simple-lisp-object-parser type stream))
 
-(defun simple-lisp-object-parser (type stream &optional coerce-test coerce-function)
+(defun simple-lisp-object-parser (type stream &optional coerce-test coerce-function (package *package*))
   (loop
     (let ((token (read-token stream)))
       (when (input-editing-stream-p stream)
 	(rescan-if-necessary stream))
       (multiple-value-bind (object index)
-	  (let ((*read-eval* nil))		;disable "#."
+	  (let ((*read-eval* nil)
+		(*package* package))	;disable "#."
 	    (read-from-string token nil token))
 	(when (eq object token)
 	  (simple-parse-error "Unexpected EOF"))
@@ -88,7 +89,8 @@
   :history symbol)
 
 (define-presentation-method accept ((type keyword) stream (view textual-view) &key)
-  (values (intern (read-token stream) *keyword-package*)))
+  (simple-lisp-object-parser type stream nil nil *keyword-package*))
+
 
 ;;; This is needed because KEYWORD is not a built-in-class
 (define-presentation-method presentation-typep (object (type keyword))
@@ -429,6 +431,7 @@
       (declare (ignore success))
       (handler-bind ((error
 		       #'(lambda (error)
+			   (declare (ignore error))
 			   (simple-parse-error "Error parsing pathname string ~A" string))))
         (unless pathname
 	  (setq pathname (parse-namestring string nil default)))
@@ -752,6 +755,8 @@
 			stream))))
       (declare (dynamic-extent #'possibility-printer))
       (loop
+	(when (eq (read-gesture :stream stream :peek-p t :timeout 0) *end-of-file-marker*)
+	  (return-from accept (nreverse list)))
 	(let ((element
 		(with-delimiter-gestures (separators)
 		  (completing-from-suggestions
diff --git a/clim/view-defs.lisp b/clim/view-defs.lisp
index 4dc14cea2970387d2aad449112b4ead63ae8be0e..5fe69fc917d1fbfca0441f106ce057da4ed861f2 100644
--- a/clim/view-defs.lisp
+++ b/clim/view-defs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: view-defs.lisp,v 1.12 92/10/28 08:19:42 cer Exp $
+;; $fiHeader: view-defs.lisp,v 1.13 1993/05/25 20:41:07 cer Exp $
 
 (in-package :clim-internals)
 
@@ -34,6 +34,9 @@
 (defvar +gadget-menu-view+ (make-instance 'gadget-menu-view))
 (defvar +pointer-documentation-view+ (make-instance 'pointer-documentation-view))
 
+(defclass iconic-view (gadget-view) ())
+(defvar +iconic-view+ (make-instance 'iconic-view))
+
 
 ;;; Indirect views for toolkit integration
 
diff --git a/demo/bitmap-editor.lisp b/demo/bitmap-editor.lisp
index d30f7038d80207261af4c177f793f24909a7799d..9347835b9fdee1e78eb45388033c1cad569892a3 100644
--- a/demo/bitmap-editor.lisp
+++ b/demo/bitmap-editor.lisp
@@ -1,26 +1,4 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
-
-;;
-;;				-[Mon Sep 13 17:49:24 1993 by colin]-
-;; 
-;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
-;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
-;;
-;; The software, data and information contained herein are proprietary
-;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
-;; given in confidence by Franz, Inc. pursuant to a written license
-;; agreement, and may be stored and used only in accordance with the terms
-;; of such license.
-;;
-;; Restricted Rights Legend
-;; ------------------------
-;; Use, duplication, and disclosure of the software, data and information
-;; contained herein by any agency, department or entity of the U.S.
-;; Government are subject to restrictions of Restricted Rights for
-;; Commercial Software developed at private expense as specified in FAR
-;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
-;; applicable.
-;;
 ;; $fiHeader: bitmap-editor.lisp,v 1.16 1993/07/27 01:45:10 colin Exp $
 
 (in-package :clim-demo)
@@ -106,7 +84,7 @@
     (run-frame-top-level fr)
     (with-slots (colors current-color) frame
       (setq current-color (length colors)
-	    colors (append colors (list (color fr)))))))
+	    colors (append colors (list (frame-color fr)))))))
 
 
 (define-bitmap-editor-command (com-choose-options :menu t)
@@ -216,6 +194,6 @@
   (list presentation object))
 
 
-
 (define-demo "Bitmap Editor" bitmap-editor
   :left 100 :top 100 :width 700 :height 500)
+
diff --git a/demo/color-editor.lisp b/demo/color-editor.lisp
index 4ea11153ddde49d7d21e6e0fcf61566ba0924ba2..cfc02771c39f52e1af84fccc85f11d5196639b58 100644
--- a/demo/color-editor.lisp
+++ b/demo/color-editor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: color-editor.lisp,v 1.11 1993/07/27 01:45:18 colin Exp $
+;; $fiHeader: color-editor.lisp,v 1.12 1993/09/17 00:20:23 colin Exp $
 
 (in-package :clim-demo)
 
@@ -85,13 +85,13 @@
 		    (make-dynamic-color +black+)
 		    +black+))))
 
-(defmethod color ((frame color-chooser))
+(defmethod frame-color ((frame color-chooser))
   (with-slots (color dynamic-p) frame
     (if dynamic-p
 	(dynamic-color-color color)
 	color)))
 
-(defmethod (setf color) (new-color (frame color-chooser))
+(defmethod (setf frame-color) (new-color (frame color-chooser))
   (with-slots (color dynamic-p) frame
     (if dynamic-p
 	(setf (dynamic-color-color color) new-color)
@@ -111,16 +111,16 @@
        (defmethod value-changed-callback
 		  ((slider slider) (client (eql 'color)) (id (eql ',color)) value)
 	 (let ((frame (pane-frame slider)))
-	   (multiple-value-bind (,@rgb) (color-rgb (color frame))
+	   (multiple-value-bind (,@rgb) (color-rgb (frame-color frame))
 	     (declare (ignore ,color))
-	     (setf (color frame) (make-rgb-color ,@new-rgb)))
+	     (setf (frame-color frame) (make-rgb-color ,@new-rgb)))
 	   (update-ihs frame)))
        (defmethod drag-callback
 		  ((slider slider) (client (eql 'color)) (id (eql ',color)) value)
 	 (let ((frame (pane-frame slider)))
-	   (multiple-value-bind (,@rgb) (color-rgb (color frame))
+	   (multiple-value-bind (,@rgb) (color-rgb (frame-color frame))
 	     (declare (ignore ,color))
-	     (setf (color frame) (make-rgb-color ,@new-rgb)))
+	     (setf (frame-color frame) (make-rgb-color ,@new-rgb)))
 	   (update-ihs frame))))))
 
 (define-rgb-callbacks red)
@@ -129,7 +129,7 @@
 
 (defmethod update-ihs ((frame color-chooser))
   (with-slots (intensity hue saturation) frame
-    (multiple-value-bind (ii hh ss) (color-ihs (color frame))
+    (multiple-value-bind (ii hh ss) (color-ihs (frame-color frame))
       (setf (gadget-value intensity :invoke-callback nil) ii)
       (setf (gadget-value hue :invoke-callback nil) hh)
       (setf (gadget-value saturation :invoke-callback nil) ss))))
@@ -142,16 +142,16 @@
        (defmethod value-changed-callback
 		  ((slider slider) (client (eql 'color)) (id (eql ',color)) value)
 	 (let ((frame (pane-frame slider)))
-	   (multiple-value-bind (,@ihs) (color-ihs (color frame))
+	   (multiple-value-bind (,@ihs) (color-ihs (frame-color frame))
 	     (declare (ignore ,color))
-	     (setf (color frame) (make-ihs-color ,@new-ihs)))
+	     (setf (frame-color frame) (make-ihs-color ,@new-ihs)))
 	   (update-rgb frame)))
        (defmethod drag-callback
 		  ((slider slider) (client (eql 'color)) (id (eql ',color)) value)
 	 (let ((frame (pane-frame slider)))
-	   (multiple-value-bind (,@ihs) (color-ihs (color frame))
+	   (multiple-value-bind (,@ihs) (color-ihs (frame-color frame))
 	     (declare (ignore ,color))
-	     (setf (color frame) (make-ihs-color ,@new-ihs)))
+	     (setf (frame-color frame) (make-ihs-color ,@new-ihs)))
 	   (update-rgb frame))))))
 
 (define-ihs-callbacks intensity)
@@ -160,7 +160,7 @@
 
 (defmethod update-rgb ((frame color-chooser))
   (with-slots (red green blue) frame
-    (multiple-value-bind (rr gg bb) (color-rgb (color frame))
+    (multiple-value-bind (rr gg bb) (color-rgb (frame-color frame))
       (setf (gadget-value red :invoke-callback nil) rr)
       (setf (gadget-value green :invoke-callback nil) gg)
       (setf (gadget-value blue :invoke-callback nil) bb))))
@@ -174,6 +174,10 @@
 	;; by changing the color in-place
 	(redisplay-frame-pane (pane-frame slider) 'display)))))
 
-
+(define-color-chooser-command com-quit-color-chooser
+    ()
+  (frame-exit *application-frame*))
 
+
 (define-demo "Color Chooser" color-chooser)
+
diff --git a/demo/ico.lisp b/demo/ico.lisp
index 696c57b3494d512ae7367db0d2e309bb0392353b..9669ebbc3854fc0667a0d3ba31108a59c70a2b49 100644
--- a/demo/ico.lisp
+++ b/demo/ico.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: ico.lisp,v 1.18 1993/07/27 01:45:32 colin Exp $
+;; $fiHeader: ico.lisp,v 1.19 1993/09/17 00:20:37 colin Exp $
 
 ;;;
 ;;; Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved. 
@@ -42,7 +42,10 @@
   (:panes
     (target :application :width 400 :height 400)
     (options :accept-values
+	     :scroll-bars nil
+	     :min-width :compute 
 	     :width :compute :height :compute
+	     :max-height :compute
 	     :display-function `(accept-values-pane-displayer
 				  :displayer display-options-pane)))
   (:layouts (:default (vertically () target options))))
diff --git a/demo/navfun.lisp b/demo/navfun.lisp
index ca86340731420f89e8bf5f895aad78260ee3b5fc..acf75e1229e81fb25212b0b1f1df40e6112826c2 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.26 1993/07/27 01:45:39 colin Exp $
+;; $fiHeader: navfun.lisp,v 1.27 1993/09/17 00:20:42 colin Exp $
 
 (in-package :clim-demo)
 
@@ -43,9 +43,6 @@
 (defvar *label-text-style* #+Genera '(:fix :roman :small)
 			   #-Genera '(:fix :roman :normal))
 
-(defclass iconic-view (gadget-view) ())
-(defvar +iconic-view+ (make-instance 'iconic-view))
-
 
 ;;; Basic data structures - points and positions
 
@@ -1651,5 +1648,5 @@
   t)
 
 
-
 (define-demo "Flight Planner" flight-planner :width 1000 :height 800)
+
diff --git a/demo/palette.lisp b/demo/palette.lisp
index ab84c148ed8a4af275a9a9cb5132dd22003a113e..a2a8f02e62b20140f9049e0f6c5a4fdf8a2a3024 100644
--- a/demo/palette.lisp
+++ b/demo/palette.lisp
@@ -1,29 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
-
-;;
-;;				-[Mon Sep 13 17:55:07 1993 by colin]-
-;; 
-;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
-;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
-;;
-;; The software, data and information contained herein are proprietary
-;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
-;; given in confidence by Franz, Inc. pursuant to a written license
-;; agreement, and may be stored and used only in accordance with the terms
-;; of such license.
-;;
-;; Restricted Rights Legend
-;; ------------------------
-;; Use, duplication, and disclosure of the software, data and information
-;; contained herein by any agency, department or entity of the U.S.
-;; Government are subject to restrictions of Restricted Rights for
-;; Commercial Software developed at private expense as specified in FAR
-;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
-;; applicable.
-;;
 ;; $fiHeader: palette.lisp,v 1.4 1993/07/27 01:45:51 colin Exp $
 
-
 (in-package :clim-demo)
 
 (define-application-frame gadget-demo ()
@@ -59,6 +36,4 @@ text field gadget"
 	text-field text-editor list-pane option-pane))))
 
 
-
 (define-demo "Gadget demo" gadget-demo)
-
diff --git a/demo/plot.lisp b/demo/plot.lisp
index 83a369cf887c5708d5233d3008bfcca538b3e05f..fc9324b75579bcec488105e7e3d38df5ed5883d0 100644
--- a/demo/plot.lisp
+++ b/demo/plot.lisp
@@ -1,27 +1,5 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
-
-;;
-;;				-[Mon Sep 13 17:55:50 1993 by colin]-
-;; 
-;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
-;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
-;;
-;; The software, data and information contained herein are proprietary
-;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
-;; given in confidence by Franz, Inc. pursuant to a written license
-;; agreement, and may be stored and used only in accordance with the terms
-;; of such license.
-;;
-;; Restricted Rights Legend
-;; ------------------------
-;; Use, duplication, and disclosure of the software, data and information
-;; contained herein by any agency, department or entity of the U.S.
-;; Government are subject to restrictions of Restricted Rights for
-;; Commercial Software developed at private expense as specified in FAR
-;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
-;; applicable.
-;;
-;; $fiHeader: plot.lisp,v 1.27 1993/09/07 21:46:27 colin Exp $
+;; $fiHeader: plot.lisp,v 1.26 1993/08/12 16:03:37 cer Exp $
 
 (in-package :clim-demo)
 
@@ -812,3 +790,17 @@
 
 
 (define-demo "Plotting Demo" plot-demo)
+
+(define-plot-demo-command com-zoom-graph-point
+    ((point 'graph-point))
+  (describe point))
+
+(define-presentation-to-command-translator zoom-around-center
+    (graph-point com-zoom-graph-point plot-demo
+		 :menu nil
+		 :documentation 
+		 ((object stream)
+	          (write-string "Foo!" stream))
+		 :gesture :select)
+  (object)
+  object)
diff --git a/demo/process-browser.lisp b/demo/process-browser.lisp
index 1cd06172824d4528bc88646f876e1ed9fb393bdc..d3032aec9d5fe84226b2fa4fa58831d2023081b4 100644
--- a/demo/process-browser.lisp
+++ b/demo/process-browser.lisp
@@ -1,29 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
-
-;;
-;;				-[Mon Sep 13 17:56:12 1993 by colin]-
-;; 
-;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
-;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
-;;
-;; The software, data and information contained herein are proprietary
-;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
-;; given in confidence by Franz, Inc. pursuant to a written license
-;; agreement, and may be stored and used only in accordance with the terms
-;; of such license.
-;;
-;; Restricted Rights Legend
-;; ------------------------
-;; Use, duplication, and disclosure of the software, data and information
-;; contained herein by any agency, department or entity of the U.S.
-;; Government are subject to restrictions of Restricted Rights for
-;; Commercial Software developed at private expense as specified in FAR
-;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
-;; applicable.
-;;
 ;; $fiHeader: process-browser.lisp,v 1.7 1993/07/27 01:46:02 colin Exp $
 
-
 (in-package :clim-demo)
 
 (define-application-frame process-browser ()
diff --git a/hpgl/pkg.lisp b/hpgl/pkg.lisp
index 9b4e052c5ea4b536b65676fca0f3eec57cbaf0ca..7fe74c3e281d867db47e8c7e481830ab4afe186f 100644
--- a/hpgl/pkg.lisp
+++ b/hpgl/pkg.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: pkg.lisp,v 1.2 93/04/02 13:36:24 cer Exp $
+;; $fiHeader: pkg.lisp,v 1.3 1993/07/27 01:47:27 colin Exp $
 
 "Copyright (c) 1991 by International Lisp Associates.  All rights reserved."
 "Portions copyright (c) 1992 Franz Inc. All rights reserved"
@@ -12,3 +12,6 @@
 (defpackage :hpgl-clim
   (:export #:with-output-to-hpgl-stream)
   (:use clim-lisp clim-sys clim clim-utils clim-silica))
+
+#+Allegro
+(setf (package-definition-lock (find-package :hpgl-clim)) t)
diff --git a/misc/train.lisp b/misc/train.lisp
index ae8df173f6cd8c81db869bf6401e61e756bea804..921928553a928fe9588c90364899e352638eceff 100644
--- a/misc/train.lisp
+++ b/misc/train.lisp
@@ -1,4 +1,4 @@
-;; -*- mode: common-lisp; package: user -*-
+; -*- mode: common-lisp; package: user -*-
 ;;
 ;;				-[Fri Aug 20 07:36:40 1993 by layer]-
 ;; 
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: train.lisp,v 1.10 1993/07/29 20:51:36 layer Exp $
+;; $fiHeader: train.lisp,v 1.12 1993/08/31 04:54:16 layer Exp $
 
 (defun train-clim (&key (train-times 2) 
 			(psview nil)
@@ -33,6 +33,11 @@
   
   ;;(setq *global-gc-behavior* nil)
   (load "test/test.lisp")
+  
+  #-svr4 (excl:shell "ps vaxg")
+  
+  (room t)
+  
   (clim-user::with-test-reporting (:file (if (excl::featurep :clim-motif) 
 					     "test-suite-reportxm.lisp"
 					   "test-suite-reportol.lisp"))
@@ -52,6 +57,37 @@
       (load "test/hpgl-tests.lisp")
       (clim-user::run-hpgl-tests :output hpglview)))
   
+  (room t)
+  (gc t)
+  (room t)
+
+  #+ignore
+  (format t "Counters are ~S~%"  
+	  tk::(list *string-counter* *font-counter* *color-counter* *widget-count*))
+
+
+  #+ignore
+  (progn
+    (format t "Port mapping ~S~%" (silica::port-mirror->sheet-table (clim:find-port)))
+    
+    #+verbose
+    (maphash #'(lambda  (x y) 
+		 (print y))
+	     (silica::port-mirror->sheet-table (clim:find-port)))
+    
+    (format t "Port framem ~S~%" (find-frame-manager :port (clim:find-port)))
+    (format t "Port framem frames ~S~%" (frame-manager-frames
+					 (find-frame-manager :port (clim:find-port))))
+    
+    (format t " Address mapping ~S~%" tk::*address->object-mapping*)
+    
+    #+verbose
+    (maphash #'(lambda  (x y) (print y))
+	     tk::*address->object-mapping*))
+  
+  
+  #-svr4 (excl:shell "ps vaxg")
+  
   (when (fboundp 'generate-coverage-report)
     (with-open-file (*standard-output* (if (excl::featurep :clim-motif) 
 					   "coverage-reportxm.lisp"
diff --git a/postscript/pkgdcl.lisp b/postscript/pkgdcl.lisp
index e88edf64b2ea7eaa8fff1313f8a33464d12a2821..33949c195e885a5feec99c1ab48903751ba5ba27 100644
--- a/postscript/pkgdcl.lisp
+++ b/postscript/pkgdcl.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: pkgdcl.lisp,v 1.5 1993/07/27 01:48:30 colin Exp $
+;; $fiHeader: pkgdcl.lisp,v 1.6 1993/08/12 16:03:59 cer Exp $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user)
 
@@ -19,4 +19,6 @@
   #+(and Allegro (or :rs6000 (not (version>= 4 1))))
   (:shadowing-import-from clim-utils
     with-slots))
- 
+
+#+Allegro
+(setf (package-lock (find-package :postscript-clim)) t)
diff --git a/silica/framem.lisp b/silica/framem.lisp
index 2a4667db22b41638188fa688b10024de04394aca..efc1524082980dfc457f00f2b04f1c97c9e91c07 100644
--- a/silica/framem.lisp
+++ b/silica/framem.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: framem.lisp,v 1.29 1993/06/04 16:06:37 cer Exp $
+;; $fiHeader: framem.lisp,v 1.30 1993/07/27 01:50:43 colin Exp $
 
 (in-package :silica)
 
@@ -75,7 +75,6 @@
 
 (defmethod frame-manager-matches-options-p
 	   ((framem standard-frame-manager) port &key palette &allow-other-keys)
-  (declare (ignore palette))
   (and (eq (port framem) port)
        (eq (frame-manager-palette framem) palette)))
 
@@ -219,6 +218,6 @@
 	       options))))
 
 (defmethod make-pane-arglist ((framem standard-frame-manager) type &rest options)
-  (declare (ignore realizer type))
+  (declare (ignore type))
   (declare (non-dynamic-extent options))
   options)
diff --git a/silica/medium.lisp b/silica/medium.lisp
index 452273529d969fae75048a464a2d438998c23465..3b2003d95df7ea879892f300c92369f2cc3d1a5d 100644
--- a/silica/medium.lisp
+++ b/silica/medium.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: medium.lisp,v 1.37 1993/08/19 20:10:13 smh Exp $
+;; $fiHeader: medium.lisp,v 1.38 1993/09/07 21:46:44 colin Exp $
 
 (in-package :silica)
 
@@ -158,8 +158,7 @@
       (port-set-pane-text-style (port pane) pane m text-style))))
 
 (defmethod engraft-medium :after
-	   ((medium basic-medium) port (sheet sheet-with-resources-mixin))
-  (declare (ignore port))
+	   ((medium basic-medium) (port t) (sheet sheet-with-resources-mixin))
   ;; We set the slots directly in order to avoid running any per-port
   ;; :AFTER methods (or whatever).  That work should be done by similar
   ;; per-port methods on ENGRAFT-MEDIUM.
diff --git a/silica/mirror.lisp b/silica/mirror.lisp
index 094d9c39cc02ed8bb43901bb30d7c77f2c59d229..5cd552ddee35d2c24d6946f2dea67e2d6c428faf 100644
--- a/silica/mirror.lisp
+++ b/silica/mirror.lisp
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
-;; $fiHeader: mirror.lisp,v 1.31 1993/07/22 15:38:57 cer Exp $
+;; $fiHeader: mirror.lisp,v 1.32 1993/07/27 01:50:57 colin Exp $
 
 (in-package :silica)
 
@@ -199,7 +199,11 @@
 
 #-(or Genera Minima)			;inlining the function is enough...
 (defun (setf mirror->sheet) (sheet port mirror)
-  (setf (gethash mirror (port-mirror->sheet-table port)) sheet))
+  (let ((table (port-mirror->sheet-table port)))
+    (if sheet
+	(setf (gethash mirror table) sheet)
+      (remhash mirror table))
+    sheet))
 
 (defmethod realize-mirror :around ((port basic-port) (sheet mirrored-sheet-mixin))
   (let ((mirror
@@ -217,6 +221,7 @@
 
 (defmethod destroy-mirror :around ((port basic-port) (sheet mirrored-sheet-mixin))
   (call-next-method)
+  (setf (mirror->sheet port (sheet-direct-mirror sheet)) nil)
   (setf (sheet-direct-mirror sheet) nil))
 
 (defmethod note-sheet-grafted :after ((sheet mirrored-sheet-mixin))
diff --git a/test/test-clim-tests.lisp b/test/test-clim-tests.lisp
index 3d21a3e8427e24500e19a37e14ad4dac256a3e27..288969ad2ca717cfa01c0890a56ecbdbdda7a343 100644
--- a/test/test-clim-tests.lisp
+++ b/test/test-clim-tests.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: test-clim.lisp,v 1.11 1993/07/27 01:52:12 colin Exp $
+;; $fiHeader: test-clim-tests.lisp,v 1.1 1993/08/12 16:04:23 cer Exp $
 
 
 (in-package :clim-user)
@@ -228,14 +228,15 @@
 
 
 (defun profile-clim-tests ()
-  (exercise-frame 'test-it
-		  'clim-tests
-		  '(:width 600 :height 400)
-		  (mapcan #'(lambda (benchmark-group)
-			      (mapcar #'list (cdr benchmark-group)))
-			  *summary-contributions*)
-		  `(exit-clim-tests)
-		  :error errorp))
+  (let ((errorp *catch-errors-in-tests*))
+    (exercise-frame 'test-it
+		    'clim-tests
+		    '(:width 600 :height 400)
+		    (mapcan #'(lambda (benchmark-group)
+				(mapcar #'list (cdr benchmark-group)))
+			    *summary-contributions*)
+		    `(exit-clim-tests)
+		    :error errorp)))
 
 (defun run-profile-clim-tests (&optional (prefix "notes/profiles"))
   (let ((prof::*hidden-packages* nil)
diff --git a/test/test-clim.lisp b/test/test-clim.lisp
index ff5368491369c8d7912ead7b23bd3819ac9226d6..52f20fb01789474b4ddd23d259c7f3dd2f40cbe9 100644
--- a/test/test-clim.lisp
+++ b/test/test-clim.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: test-clim.lisp,v 1.11 1993/07/27 01:52:12 colin Exp $
+;; $fiHeader: test-clim.lisp,v 1.12 1993/08/12 16:04:25 cer Exp $
 
 
 (in-package :clim-user)
@@ -430,3 +430,24 @@
   ((com-update-boxes)
    (com-update-boxes))
   (com-quit))
+
+
+(push 'accept-from-string-tests *frame-tests*)
+
+(defun accept-from-string-tests ()
+  (with-test-success-expected ('accept-from-string-tests)
+    
+    (assert (eq nil (accept-from-string '(subset :a :b) "")))
+    (assert (equal '(:a :b) (accept-from-string '(subset :a :b) "a,b")))
+    (assert (eq :abc (accept-from-string 'keyword "abc")))
+    (handler-case (accept-from-string '(member :a :b) "")
+      (error (c) c)
+      (:no-error (&rest ignore) ignore (error "member null string failed")))
+    
+    (handler-case (accept-from-string '(member :a :b) "z")
+      (error (c) c)
+      (:no-error (&rest ignore) ignore (error "member bogus failed")))
+    
+    (handler-case (accept-from-string '(subset :a :b) "a,c")
+      (error (c) c)
+      (:no-error (&rest ignore) ignore (error "subset bogus failed")))))
diff --git a/test/test-demos.lisp b/test/test-demos.lisp
index 5668d87be154ff7e738f2fbcabc05d155887e780..b8dcd4fc5ff95ab93ef345256fe9dd28a48fc90b 100644
--- a/test/test-demos.lisp
+++ b/test/test-demos.lisp
@@ -1,6 +1,8 @@
 (in-package :clim-user)
 
-;; $fiHeader: test-demos.lisp,v 1.5 1993/08/12 16:04:30 cer Exp $
+;; $fiHeader: test-demos.lisp,v 1.6 1993/09/17 00:21:13 colin Exp $
+
+
 
 (define-frame-test test-puzzle-demo (clim-demo::puzzle)
   (
@@ -16,6 +18,8 @@
   (clim-demo::com-exit-puzzle)
   )
 
+
+
 (define-frame-test test-flight-planner (clim-demo::flight-planner :width 1000 :height 800)
   (
    (clim-demo::com-zoom-in)
@@ -69,6 +73,7 @@
   (clim-demo::com-exit-flight-planner)
   )
 
+
 ;; Listener
 
 ;;;--- The listener is using a nonstandard top level and does not
@@ -76,6 +81,17 @@
 
 (define-frame-test test-lisp-listener (clim-demo::lisp-listener :width 1000 :height 800)
   (
+   (:command clim-demo::interactor clim-demo::com-show-some-commands
+	     :colon-prefix t)
+   (:presentation-click clim-demo::interactor clim-demo::printer)
+
+   (:presentation-click clim-demo::interactor clim-internals::accept-values-choice)
+   :help
+   #\newline
+   "Santa Cruz Comic News"
+   #\newline
+   :abort
+   (:sleep 4)
    "(cons nil nil)
 "
    (:command clim-demo::interactor clim-demo::com-clear-output-history
@@ -89,6 +105,7 @@
 	    :colon-prefix t)
   )
 
+
 ;; graphics-demos
 
 (define-frame-test test-graphics-demos (clim-demo::graphics-demo :width 840 :height 800)
@@ -105,9 +122,49 @@
   (clim-demo::com-exit-graphics-demo)
   )
 
-;; cad-demo
+
+;;---- cad-demo
 
-;; address-book
+(define-frame-test test-cad-demo (clim-demo::cad-demo :width 700 :height 600)
+  (
+   (clim-demo::com-setup)
+   (:presentation-click clim-demo::design-area clim-demo::output :gesture :describe)
+   (:presentation-click clim-demo::design-area clim-demo::output :gesture :describe)
+   (:presentation-click clim-demo::design-area clim-demo::output :gesture :describe)
+   (:presentation-click clim-demo::design-area clim-demo::output :gesture :describe)
+   (clim-demo::com-refresh)
+   (clim-demo::com-clear)
+   #\s 
+   #\r 
+   #\l
+   (:commands test-cad-demo-1)
+   )
+  (clim-demo::com-exit-cad-demo))
+
+(defun test-cad-demo-1 (inv)
+  (let ((frame (invocation-frame inv)))
+    (flet ((create-gadget (type x y)
+	     (execute-one-command inv '(clim-demo::com-create-component))
+	     (with-waiting (:timeout 30)
+	       ((find-menu frame) (menu-items)
+				  menu-items
+				  (select-menu-item frame type)
+				  (click-on-window 'clim-demo::design-area x y)))))
+      
+      (create-gadget 'clim-demo::logic-zero 100 100)
+      (create-gadget 'clim-demo::logic-one  100 200)
+      (create-gadget 'clim-demo::and-gate  150 150)
+      ;;
+      (click-on-presentation 'clim-demo::design-area 'clim-demo::component)
+      (click-on-window 'clim-demo::design-area (random 200) (random 200))
+      ;;
+      #+ignore
+      (click-on-presentation 'clim-demo::design-area 'clim-demo::output)
+      #+ignore
+      (click-on-presentation 'clim-demo::design-area 'clim-demo::input))))
+       
+
+;;--- address-book
 
 (define-frame-test test-address-book (clim-demo::address-book :width 400 :height 400)
   (
@@ -118,9 +175,80 @@
   (clim-demo::com-quit-address-book)
   )
 
-;; Thinkadot
-;; plot
-;; color-editor
+
+;;--- Thinkadot
+
+;;---  plot
+
+(define-frame-test test-plot-demo (clim-demo::plot-demo)
+  (
+   (clim-demo::com-redisplay)
+   (:Commands test-plot-demo-1))
+  (clim-demo::com-quit-plot-demo))
+
+(defun test-plot-demo-1 (inv)
+  inv
+  (execute-one-command inv '(:edit-avv  clim-demo::options "Graph type" :bar))
+  (execute-one-command inv '(:edit-avv  clim-demo::options "Graph type" :pie))
+
+  ;;-- We cannot click on presentations in the above code because of
+  ;;-- the single-box problem.
+  
+  (execute-one-command inv '(:edit-avv  clim-demo::options "Graph type" :plot))
+
+  (click-on-presentation 'clim-demo::graph-window t :press nil :release nil :x-offset 5 :y-offset 5)
+
+  (execute-one-command inv "Describe region ")
+  (press-on-window 'clim-demo::graph-window 100 100)
+  (release-on-window 'clim-demo::graph-window 200 200)
+  (execute-one-command inv #\newline)
+
+  (flet ((change-data-point ()
+	   (click-on-presentation 'clim-demo::data-window 'clim-demo::data-point)
+	   (execute-one-command inv (format nil "~D" (random 30)))
+	   (execute-one-command inv #\newline))
+	 (change-y-label (label)
+	   (click-on-presentation 'clim-demo::data-window 'clim-demo::y-label)
+	   (execute-one-command inv label)
+	   (execute-one-command inv #\newline)))
+    (change-y-label "Nowhere")
+    (change-y-label "Somehere")
+    (change-data-point)
+    (change-data-point)
+    (change-data-point))
+  #+cannot-do-this
+  (execute-one-command inv '(clim-demo::com-add-new-column))
+  (execute-one-command inv '(clim-demo::com-random-update))
+  (execute-one-command inv '(clim-demo::com-add-new-row))
+  )
+
+
+;;---- color-editor
+
+(define-frame-test test-color-chooser (clim-demo::color-chooser)
+  ((:commands test-color-chooser-1))
+  (clim-demo::com-quit-color-chooser))
+
+(defun test-color-chooser-1 (inv)
+  (let ((frame (invocation-frame inv)))
+    (with-slots ((red clim-demo::red) 
+		 (green clim-demo::green) 
+		 (blue clim-demo::blue)
+		 (intensity clim-demo::intensity)
+		 (hue clim-demo::hue)
+		 (saturation clim-demo::saturation)) frame
+      (flet ((random-real (x)
+	       (* (random 100) (/ x 100))))
+	(declare (dynamic-extent #'random-real))
+	(dotimes (i 20)
+	  (change-gadget-value red (random-real 1.0))
+	  (change-gadget-value green (random-real 1.0))
+	  (change-gadget-value blue (random-real 1.0))
+	  (change-gadget-value intensity (random-real (sqrt 3)))
+	  (change-gadget-value hue (random-real 1.0))
+	  (change-gadget-value saturation (random-real 1.0)))))))
+
+  
 ;; graphics-editor
 
 (define-frame-test test-graphics-editor (clim-graphics-editor::graphics-editor :width 800 :height 600)
@@ -173,20 +301,86 @@
   (clim-graphics-editor::com-quit)
   )
 
-;; bitmap-editor
+
+
+
 ;; ico
 
-(define-frame-test test-ico (clim-demo::ico-frame :width 400 :height 400)
+(define-frame-test test-ico (clim-demo::ico-frame :width 950 :height 400)
   (
    (clim-demo::com-ico-throw-ball)
    (:sleep 30)
    (clim-demo::com-ico-catch-ball)
+   (:edit-avv clim-demo::options "Choose" (:faces))
+   (clim-demo::com-ico-throw-ball)
+   (:sleep 15)
+   (clim-demo::com-ico-catch-ball)
+   
+   (:edit-avv clim-demo::options "Buffering" :double)
+   (clim-demo::com-ico-throw-ball)
+   (:sleep 15)
+   (clim-demo::com-ico-catch-ball)
    )
   (clim-demo::com-ico-quit)
   )
 
+
 ;; browser
+
+(define-frame-test test-graphical-browser (clim-browser::browser :width 900 :height 900)
+  ((:commands do-graphical-browser-test))
+  (clim-browser::com-quit-browser))
+
+(defun do-graphical-browser-test (inv)
+  (change-query-value 'clim-browser::type :class 'clim-browser::control-panel)
+  (change-query-value 'clim-browser::subtype :subclasses 'clim-browser::control-panel)
+  (change-query-value 'clim-browser::depth 2 'clim-browser::control-panel)
+  (execute-one-command inv `(clim-browser::com-show-graph ,(find-class 'sheet)))
+  
+  ;; Build the graph up
+  (labels ((leaf-node-presentation-p (presentation)
+	     (not
+	      (clim-browser::node-inferiors 
+	       (presentation-object presentation))))
+	   (root-node-presentation-p (presentation)
+	     (not
+	      (clim-browser::node-superiors
+	       (presentation-object presentation))))
+	   (interior-node-presentation-p (presentation)
+	     (not (or (root-node-presentation-p presentation)
+		      (leaf-node-presentation-p presentation)))))
+    
+    (dotimes (i 10)
+      (click-on-presentation 'clim-browser::graph 'clim-browser::call-node
+			     :test #'leaf-node-presentation-p))
+    
+    (handler-case (dotimes (i 4)
+		    (click-on-presentation 'clim-browser::graph
+					   'clim-browser::call-node :gesture :describe
+					   :test #'leaf-node-presentation-p))
+      (cannot-find-presentation-error (c)
+	c))
+
+    (dotimes (i 4)
+      (click-on-presentation 'clim-browser::graph
+			     'clim-browser::call-node 
+			     :test #'interior-node-presentation-p
+			     :gesture :delete))
+    
+    (execute-one-command inv `(clim-browser::com-redisplay))
+    (execute-one-command inv `(clim-browser::com-redisplay))))
+  ;;
+
+
 ;; peek-frame
+
+(define-frame-test test-peek-frame (peek-frame :width 800 :height 400)
+  (
+   (:sleep 30)
+   )
+  (com-exit-peek)
+  )
+
 ;; process-browser
 
 (define-frame-test test-process-browser (clim-demo::process-browser :width 800 :height 400)
@@ -196,9 +390,19 @@
   (clim-demo::com-quit-process-browser)
   )
 
+
 ;; customer-records
+
+(define-frame-test test-custom-records (scigraph :width 600 :height 500)
+  ((com-example-1)
+   (com-example-2)
+   (com-example-3)
+   (:sleep 5)
+   (com-clear-display))
+  (com-exit-scigraph))
 ;; demo-acivity
 
+
 (define-frame-test test-bitmap-editor (clim-demo::bitmap-editor :width 700 :height 500)
   (
    (:presentation-click clim-demo::edit-pane
@@ -213,21 +417,21 @@
    )
   (clim-demo::com-bitmap-editor-quit))
 
+
+
 (pushnew 'run-all-demos *frame-tests*)
 
-(defun run-all-demos ()
+
+(defun run-all-demos (&optional (errorp *catch-errors-in-tests*))
   (dolist (demo clim-demo::*demos*)
-    (handler-case (mp::with-timeout (20)
-		    (clim-demo::run-demo demo :force t))
-      (error (c)
-	(note-test-failed (clim-demo::demo-class demo) c))
-      (:no-error (&rest ignore)
-	(declare (ignore ignore))
-	(note-test-succeeded (clim-demo::demo-class demo))))))
-
-;;-- I dont know whether this is the best place for this?
-
-#+some-where-else
-(locally (declare (special si::*clos-preload-packages*))
-  (push (find-package :clim-demo) si::*clos-preload-packages*)
-  (push (find-package :clim-user) si::*clos-preload-packages*))
+    (flet ((doit ()
+	     (mp::with-timeout (20)
+	       (clim-demo::run-demo demo :force t))))
+      (if errorp
+	  (handler-case (doit)
+	    (error (c)
+	      (note-test-failed (clim-demo::demo-class demo) c))
+	    (:no-error (&rest ignore)
+	      (declare (ignore ignore))
+	      (note-test-succeeded (clim-demo::demo-class demo))))
+	(doit)))))
diff --git a/test/test-driver.lisp b/test/test-driver.lisp
index 702c826d75ca6ee6a54726483936568299ecb435..0bf82d0218f021051e0dc0d965ba5c7cd3be7dce 100644
--- a/test/test-driver.lisp
+++ b/test/test-driver.lisp
@@ -278,7 +278,28 @@
     (if error
 	(with-test-success-expected (test-name)
 	  (doit))
-      (doit))))
+      (doit))
+    
+    #+ignore
+    (progn
+      (format t "Port mapping ~S~%" (silica::port-mirror->sheet-table (clim:find-port)))
+    
+      #+verbose
+      (maphash #'(lambda  (x y) 
+		   (print y))
+	       (silica::port-mirror->sheet-table (clim:find-port)))
+    
+      (format t "Port framem ~S~%" (find-frame-manager :port (clim:find-port)))
+      (format t "Port framem frames ~S~%" (frame-manager-frames
+					   (find-frame-manager :port (clim:find-port))))
+    
+      (format t " Address mapping ~S~%" tk::*address->object-mapping*)
+    
+      #+verbose
+      (maphash #'(lambda  (x y) (print y))
+	       tk::*address->object-mapping*))
+    
+    ))
 
 
 
@@ -392,7 +413,7 @@
 	       (incf right x-offset)
 	       (incf top y-offset)
 	       (incf bottom y-offset)
-	       (when (typep record 'standard-presentation)
+	       (when (typep record 'presentation)
 		 (funcall function record left top right bottom))
 	       (multiple-value-bind (xoff yoff) (output-record-start-cursor-position record)
 		 (map-over-output-records
@@ -408,6 +429,8 @@
   (multiple-value-setq (x y) (transform-position (sheet-device-transformation sheet) x y))
   (tk-silica::port-set-pointer-position-1 (port sheet) sheet x y))
 
+(define-condition cannot-find-presentation-error (simple-error) ())
+
 (define-test-step click-on-presentation (pane-name
 					 presentation-type 
 					 &key gesture 
@@ -450,8 +473,9 @@
 	  (sleep 1)))
       #+ignore
       (format excl:*initial-terminal-io* "~d presentations~%" (length presentations))
-      (assert presentations ()
-	"Did not find presentations to click on!")
+      (unless presentations
+	(error 'cannot-find-presentation-error :format-control
+	       "Did not find presentations to click on!"))
       (when presentations
 	(let* ((len (length presentations))
 	       (i (random len)))
@@ -686,9 +710,9 @@
 				 *unsupplied-argument-marker*)))
 		 (with-presentation-type-decoded (type-name parameters) presentation-type
 		   (when (eq type-name 'command-name)
-		     (send-it (string-downcase(command-line-name-for-command
-			       command-name
-			       command-table)))
+		     (send-it (string-downcase (command-line-name-for-command
+						command-name
+						command-table)))
 		     (return-from arg-parser (values command-name presentation-type)))
 		   (cond ((not (clim-internals::unsupplied-argument-p default))
 			  (cond ((eq type-name 'keyword-argument-name) 
@@ -781,6 +805,15 @@
 			   :gadget sheet))
   (wait-for-clim-input-state *invocation*))
 
+(defun change-gadget-value (sheet value)
+  (distribute-event
+   (port sheet)
+   (silica::allocate-event 'silica::value-changed-gadget-event
+			   :value value
+			   :gadget sheet))
+  (wait-for-clim-input-state *invocation*))
+
+
 ;; How to invoke command-buttons
 ;; It would be nice if we could change gadget values directly.
 ;; Lets say we want to run the bitmap-editor-add-color frame, change
@@ -840,7 +873,23 @@
 	   (frame-manager-frames framem)))
 
 (defun find-notify-user (frame)
-  (getf (mp:process-property-list (clim-internals::frame-top-level-process frame)) 'notify-user))
+  (getf (mp:process-property-list
+	 (clim-internals::frame-top-level-process frame))
+	'notify-user))
+
+(defun find-menu (frame)
+  (getf (mp:process-property-list (clim-internals::frame-top-level-process frame)) 'menu-choose))
+
+
+(defun abort-menu (frame)
+  (mp::process-interrupt (clim-internals::frame-top-level-process frame)
+			 #'(lambda () (throw 'menu-choose nil)))
+  (mp::process-allow-schedule))
+
+(defun select-menu-item (frame value)
+  (mp::process-interrupt (clim-internals::frame-top-level-process frame)
+			 #'(lambda () (throw 'menu-choose value)))
+  (mp::process-allow-schedule))
 
 (defun notify-user-ok (frame)
   (mp::process-interrupt (clim-internals::frame-top-level-process frame)
@@ -892,7 +941,7 @@
 (define-test-step press-push-button (button)
   (xm-silica::queue-active-event nil nil button))
 
-(defmacro with-waiting ((&body timeout) &body clauses)
+(defmacro with-waiting ((&key timeout) &body clauses)
   (let ((i 0)
 	(result (gensym))
 	(which (gensym))
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 7c25e9b19d615f98702d9e0b31712a891222d305..275da5892264fe951dbf8f6619623d99e2e14178 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.70 1993/07/30 23:58:14 colin Exp $
+;; $fiHeader: test-suite.lisp,v 1.71 1993/09/17 00:21:17 colin Exp $
 
 (in-package :clim-user)
 
@@ -1947,24 +1947,29 @@ Luke Luck licks the lakes Luke's duck likes."))
   (macrolet ((doit (&body body)
 	       `(mp::with-timeout (5) ,@body)))
     (doit
-      (menu-choose '("Whistle"
-		     ("Pat head" :items
-		      (("with right hand" . "Pat head with right hand")
-		       ("with left hand" . "Pat head with left hand")))
-		     ("Rub Tummy" :items
-		      (("clockwise" . "Rub tummy clockwise")
-		       ("counter-clockwise" . "Rub tummy counter-clockwise")))
-		     "Walk"
-		     "Chew Gum")
-		   :associated-window stream
-		   :label "Select an activity"))
+     (menu-choose '("Whistle"
+		    ("Pat head" :items
+		     (("with right hand" . "Pat head with right hand")
+		      ("with left hand" . "Pat head with left hand")))
+		    ("Rub Tummy" :items
+		     (("clockwise" . "Rub tummy clockwise")
+		      ("counter-clockwise" . "Rub tummy counter-clockwise")))
+		    "Walk"
+		    "Chew Gum")
+		  :associated-window stream
+		  :label "Select an activity"))
     (doit
      (menu-choose '(1872812 "kdjfkdjf" 908909)
-		   :label "foo" :text-style '(:fix :roman :huge)))
+		  :label "foo" :text-style '(:fix :roman :huge)))
     (doit
-      (menu-choose '("akjdfkjdf" "bdfkj" "cdfkj")
-		   :label '("Foo" :text-style (:serif :bold :huge)) 
-		   :text-style '(:fix :roman :huge)))))
+     (menu-choose '("akjdfkjdf" "bdfkj" "cdfkj")
+		  :label '("Foo" :text-style (:serif :bold :huge)) 
+		  :text-style '(:fix :roman :huge)))
+    (dotimes (i 5)
+      (doit
+       (menu-choose '("akjdfkjdf" "bdfkj" "cdfkj")
+		    :label '("Foo" :text-style (:serif :bold :huge)) 
+		    :printer #'princ)))))
 
 (define-test (graphical-menu menus-and-dialogs) (stream)
   "A menu that contains graphics."
diff --git a/tk-silica/image.lisp b/tk-silica/image.lisp
index cb6cbd2120141b76031ef42ad8ac3cbcefe0ac58..e2bbece3a733f916aefb32c9c254398c15247a28 100644
--- a/tk-silica/image.lisp
+++ b/tk-silica/image.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: image.lisp,v 1.14 1993/07/27 01:54:53 colin Exp $
+;; $fiHeader: image.lisp,v 1.15 1993/09/07 21:47:04 colin Exp $
 
 (in-package :xm-silica)
 
@@ -47,27 +47,28 @@
       (let ((p (merge-pathnames pathname dir))) 
 	(when (probe-file p)
 	  (return (setq pathname p))))))
-  (if (member format '(:bitmap :pixmap))
-      (with-open-file (fstream pathname :direction :input)
-	(case format
-	  (:bitmap
-	   (read-bitmap-file-1 fstream))
-	  (:pixmap
-	   (read-pixmap-file-1 fstream (port-default-palette port)))))
-    (multiple-value-bind
-	(format filter)
-	(compute-filter-for-bitmap-format format)
-      (with-open-stream (fstream (excl:run-shell-command
-				  (format nil "cat ~A | ~A"
-					  (truename pathname) filter)
-				  :wait nil
-				  :error-output :stream
-				  :output :stream))
-	(ecase format
-	  (:bitmap
-	   (read-bitmap-file-1 fstream))
-	  (:pixmap
-	   (read-pixmap-file-1 fstream (port-default-palette port))))))))
+  (let ((palette (and port (port-default-palette port))))
+    (if (member format '(:bitmap :pixmap))
+	(with-open-file (fstream pathname :direction :input)
+	  (case format
+	    (:bitmap
+	     (read-bitmap-file-1 fstream))
+	    (:pixmap
+	     (read-pixmap-file-1 fstream palette))))
+      (multiple-value-bind
+	  (format filter)
+	  (compute-filter-for-bitmap-format format)
+	(with-open-stream (fstream (excl:run-shell-command
+				    (format nil "cat ~A | ~A"
+					    (truename pathname) filter)
+				    :wait nil
+				    :error-output :stream
+				    :output :stream))
+	  (ecase format
+	    (:bitmap
+	     (read-bitmap-file-1 fstream))
+	    (:pixmap
+	     (read-pixmap-file-1 fstream palette))))))))
 
 (defmethod compute-filter-for-bitmap-format (format)
   (error "Dont know how to convert from the format ~A" format))
@@ -141,8 +142,10 @@
 		 (let ((next (peek-char t fstream)))
 		   (if (eq next #\,) (read-char fstream)
 		     (return (nreverse strings)))))))
-	   (convert-color (x)
-	     (find-named-color x palette)))
+	      (convert-color (x)
+		(if palette
+		    (find-named-color x palette)
+		  x)))
       (let ((colors (do ((colors (read-strings) (cddr colors))
 			 (r nil))
 			((null colors) r)
diff --git a/tk-silica/last.lisp b/tk-silica/last.lisp
index b3b2ac3d6b25f7da81ef64db818959559e12af90..07278917bbe6b476cac2a02af64ae42890af7239 100644
--- a/tk-silica/last.lisp
+++ b/tk-silica/last.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: last.lisp,v 1.3 93/04/16 09:26:43 layer Exp $
+;; $fiHeader: last.lisp,v 1.4 1993/07/27 01:54:56 colin Exp $
 
 
 (in-package :system)
@@ -34,3 +34,4 @@
    (merge-pathnames "update-clim-2.0"
 		    excl::*library-pathname*)))
  :devel (locally (declare (special system::*devel*)) system::*devel*))
+
diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp
index d7ffdd145df9460176c36b5d483b595582793af8..b7af67856f18d531134f7ecbfe387489c73c0ed1 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.58 1993/07/30 23:58:36 colin Exp $
+;; $fiHeader: ol-gadgets.lisp,v 1.59 1993/08/12 16:05:03 cer Exp $
 
 
 (in-package :xm-silica)
@@ -821,12 +821,11 @@
   (let ((mirror (sheet-direct-mirror rb)))
     (multiple-value-bind (orientation measure)
 	(tk::get-values mirror :layout-type :measure)
-      (let* ((sum-w 0)
-	     (max-w 0)
+      (let* ((max-w 0)
 	     (max-h 0)
-	     (sum-h 0)
 	     (all-children (tk::widget-children mirror))
-	     (n (ceiling (length all-children) measure)))
+	     (n (ceiling (length all-children) measure))
+	     (max-column-widths (make-list n :initial-element 0)))
 
 	(let ((children all-children)
 	      child)
@@ -835,49 +834,44 @@
 
 	    ;; Walk over one row/column
 	  
-	    (let ((one-sum-w 0)
-		  (one-max-w 0)
-		  (one-max-h 0)
-		  (one-sum-h 0)
-		  (done 0))
+	    (let ((one-max-w 0)
+		  (one-max-h 0))
 
 	      (dotimes (i n)
 		(unless children (return nil))
-		(incf done)
 		(setq child (pop children))
 		(multiple-value-bind
 		    (ignore-x igore-y width height)
 		    (xt::widget-best-geometry child)
 		  (declare (ignore ignore-x igore-y))
 		  (maxf one-max-h height)
-		  (incf one-sum-w width)
-		  (incf one-sum-h height)
-		  (maxf one-max-w width)))
+		  (maxf one-max-w width)
+		  (maxf (elt max-column-widths i)
+			(case orientation
+			  (:fixedrows width)
+			  (:fixedcols height)))))
 	  
 	      ;; If there is more then we need to add some spacing in
 	  
 	      (ecase orientation
 		(:fixedrows 
 		 ;; We have just done a row
-		 (incf one-sum-w (* spacing (1- done)))
 		 (when children (incf one-max-h spacing))
-		 (maxf sum-w one-sum-w)
-		 (incf max-h one-max-h)
-		 )
+		 (incf max-h one-max-h))
 		(:fixedcols 
 		 ;; We have just done a colum
-		 (incf one-sum-h (* spacing done))
 		 (when children (incf one-max-w spacing))
-		 (maxf sum-h one-sum-h)
 		 (incf max-w one-max-w))))))
       
 	(ecase orientation
 	  (:fixedrows (make-space-requirement 
-		       :width sum-w
+		       :width (+ (reduce #'+ max-column-widths)
+				 (* spacing (1- n)))
 		       :height max-h))
 	  (:fixedcols (make-space-requirement 
 		       :width max-w 
-		       :height sum-h)))))))
+		       :height (+ (reduce #'+ max-column-widths)
+				  (* spacing (1- n))))))))))
 
 ;;;
 
@@ -1913,14 +1907,17 @@
 				     pattern
 				     text-style)
   (declare (ignore directory pattern text-style))
-  (let ((pathname nil)
-	(stream (frame-top-level-sheet frame)))
+  (let ((pathname (and directory (pathname directory)))
+	(stream (frame-top-level-sheet frame))
+	(view '(text-field-view :width (60 :character))))
     (accepting-values (stream :own-window t :label title :exit-boxes exit-boxes)
 	(setf pathname 
 	  (if pathname
 	      (accept 'pathname :prompt "File" :default pathname
+		      :view view
 		      :stream stream)
 	    (accept 'pathname :prompt "File"
+		    :view view
 		    :stream stream))))))
 
 (defmethod silica::port-set-pane-text-style ((port openlook-port) pane m text-style)
diff --git a/tk-silica/ol-silica.lisp b/tk-silica/ol-silica.lisp
index d5b99026097318bba5ad9cbbbe4abc74af38b8a1..0f407d27204739ffdcf0fc1b2019710295790af4 100644
--- a/tk-silica/ol-silica.lisp
+++ b/tk-silica/ol-silica.lisp
@@ -20,13 +20,17 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-silica.lisp,v 1.20 93/05/13 16:31:42 colin Exp $
+;; $fiHeader: ol-silica.lisp,v 1.21 1993/07/27 01:55:11 colin Exp $
 
 (in-package :xm-silica)
 
 (defclass openlook-port (xt-port) ()
   (:default-initargs :deep-mirroring t))
 
+(defmethod initialize-instance :before ((port openlook-port) &key)
+  (unless (sys:getenv "OPENWINHOME")
+    (warn "OPENWINHOME environment variable is not set")))
+
 (defmethod find-port-type ((type (eql :openlook)))
   'openlook-port)
 
diff --git a/tk-silica/pkg.lisp b/tk-silica/pkg.lisp
index 5831fd9dde263805275fdad45b036fa580a409a6..44127308b58d35ae51803b837be17ec825273d80 100644
--- a/tk-silica/pkg.lisp
+++ b/tk-silica/pkg.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: pkg.lisp,v 1.9 93/04/02 18:41:09 cer Exp $
+;; $fiHeader: pkg.lisp,v 1.11 1993/08/31 04:54:59 layer Exp $
 
 (defpackage :tk-silica
   (:nicknames :xm-silica :xt-silica)
@@ -59,4 +59,5 @@
    
    ))
 
-(in-package :tk-silica)
+
+(setf (package-definition-lock (find-package :tk-silica)) t)
diff --git a/tk-silica/xm-frames.lisp b/tk-silica/xm-frames.lisp
index 70d7d292955083a3f5e4de612a83a866c9b004b5..d67fe4c654969a4af3a2f2869621fd4350aa9bd5 100644
--- a/tk-silica/xm-frames.lisp
+++ b/tk-silica/xm-frames.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-frames.lisp,v 1.60 1993/07/22 15:39:35 cer Exp $
+;; $fiHeader: xm-frames.lisp,v 1.61 1993/07/27 01:55:21 colin Exp $
 
 (in-package :xm-silica)
 
@@ -377,7 +377,7 @@
 		      :orientation (if row-wise 
 				       :horizontal
 				     :vertical)
-		      :packing :column
+		      :packing (if (or n-columns n-rows) :column :tight)
 		      :num-columns 
 		      (or n-columns
 			  (and n-rows
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index 080d78dc8904e43a2ce556d7e303b93fa70806c8..4dbb7d95e624b8cd3d3ebcfa8fe69418d0c25481 100644
--- a/tk-silica/xm-gadgets.lisp
+++ b/tk-silica/xm-gadgets.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-gadgets.lisp,v 1.80 1993/08/12 16:05:07 cer Exp $
+;; $fiHeader: xm-gadgets.lisp,v 1.81 1993/09/07 21:47:09 colin Exp $
 
 (in-package :xm-silica)
 
@@ -1107,7 +1107,7 @@
   (let ((m (sheet-direct-mirror gadget)))
     (when m
       (with-accessors ((name-key set-gadget-name-key)) gadget
-	(tk::set-values m :items (mapcar name-key items))))))
+	(tk::set-values m :items (mapcar name-key items) :item-count (length items))))))
 
 (defun list-pane-single-selection-callback (widget item-position sheet)
   (declare (ignore item-count))
@@ -1416,7 +1416,7 @@
         (get-selection-box-child dialog :ok :cancel :help)
       (when directory
 	(tk::set-values dialog :directory directory))
-    
+
       (when pattern
 	(tk::set-values dialog :pattern pattern))
     
@@ -1816,3 +1816,5 @@
 			*default-text-style*)))
     `(:font-list ,(text-style-mapping port text-style) ,@initargs)))
 			      
+
+
diff --git a/tk-silica/xm-silica.lisp b/tk-silica/xm-silica.lisp
index 884fd9c5ee19489599d3bc2cdafc7ccbf80b666a..c3bf92137b5b338bcbc124cd22baa61c675f7f7b 100644
--- a/tk-silica/xm-silica.lisp
+++ b/tk-silica/xm-silica.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-silica.lisp,v 1.37 1993/05/25 20:42:40 cer Exp $
+;; $fiHeader: xm-silica.lisp,v 1.38 1993/07/22 15:39:42 cer Exp $
 
 (in-package :xm-silica)
 
@@ -186,3 +186,11 @@
     (when m (tk::xm_process_traversal m 0))))
 
 
+;;;--- dont do this for a while since it destroys other things.
+
+#+ignore
+(defmethod destroy-mirror :around ((port xt-port) (sheet top-level-sheet))
+  (let* ((m (sheet-direct-mirror sheet))
+	 (shell (and m (tk::widget-parent m))))
+    (call-next-method)
+    (when shell (tk::destroy-widget shell))))
diff --git a/tk-silica/xt-frames.lisp b/tk-silica/xt-frames.lisp
index faf712d0926448400fd8671de398c2e93a25f0c6..84f85d5250341414c695d03ab165d51604126f98 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.39 1993/09/07 21:47:14 colin Exp $
+;; $fiHeader: xt-frames.lisp,v 1.40 1993/09/17 00:21:27 colin Exp $
 
 
 (in-package :xm-silica)
@@ -257,7 +257,6 @@
       (tk::set-values shell
 		      :min-width (fix-coordinate width)
 		      :min-height (fix-coordinate height)))
-
     (let ((geo (clim-internals::frame-geometry frame)))
       (destructuring-bind
 	  (&key left top width height &allow-other-keys) geo
diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp
index b7ef9d722445c2f467a69ba478db73a3169bf1f6..4d7f67a71c402682cc3ee2215465b718075e0785 100644
--- a/tk-silica/xt-graphics.lisp
+++ b/tk-silica/xt-graphics.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-graphics.lisp,v 1.78 1993/09/07 21:47:23 colin Exp $
+;; $fiHeader: xt-graphics.lisp,v 1.79 1993/09/17 00:21:30 colin Exp $
 
 (in-package :tk-silica)
 
@@ -964,6 +964,7 @@
 	     (thickness (line-style-thickness line-style))
 	     (sheet (medium-sheet medium))
 	     (transform (sheet-device-transformation sheet)))
+	;;--rounding
 	(convert-to-device-coordinates transform x y)
 	(discard-illegal-coordinates medium-draw-point* x y)
 	(cond ((< thickness 1.5)
@@ -1056,6 +1057,9 @@
 		      drawable
 		      (adjust-ink (decode-ink ink medium)
 				  medium
+				  ;;--rounding
+				  ;;-- This seems like the wrong values
+				  ;;-- need to subtract thickness
 				  minx
 				  miny)
 		      points
@@ -1074,6 +1078,7 @@
 	   drawable
 	   (adjust-ink (decode-ink ink medium)
 		       medium
+		       ;;-- This is not right in the case of thin lines
 		       (the fixnum (min (the fixnum x1) (the fixnum x2)))
 		       (the fixnum (min (the fixnum y1) (the fixnum y2))))
 	   x1 y1 x2 y2))))))
@@ -1139,8 +1144,8 @@
 	     (sheet (medium-sheet medium))
 	     (transform (sheet-device-transformation sheet)))
 	(assert (rectilinear-transformation-p transform))
-	(convert-to-device-coordinates transform
-				       x1 y1 x2 y2)
+	;;--rounding
+	(convert-to-device-coordinates transform x1 y1 x2 y2)
 	;; Clipping a rectangle is ridiculously easy.
 	(unless (valid-point-p x1 y1)
 	  (setq x1 (min (max -32000 (the fixnum x1)) 32000))
@@ -1176,6 +1181,7 @@
 	(assert (rectilinear-transformation-p transform))
 	(macrolet ((guts (x1 y1 x2 y2)
 		     `(let ((x1 ,x1) (y1 ,y1) (x2 ,x2) (y2 ,y2))
+			;;--rounding
 			(convert-to-device-coordinates transform x1 y1 x2 y2)
 			;; Clipping a rectangle is ridiculously easy.
 			(unless (valid-point-p x1 y1)
@@ -1297,6 +1303,7 @@
 	(rotatef start-angle end-angle)
 	(when (< end-angle start-angle)
 	  (setq end-angle (+ end-angle 2pi)))
+	;;--rounding in draw-ellipse
 	(tk::draw-ellipse
 	  drawable
 	  (adjust-ink (decode-ink (medium-ink medium) medium)
@@ -1322,6 +1329,9 @@
 	     (text-style (medium-merged-text-style medium))
 	     (font (text-style-mapping port text-style))
 	     (ascent (tk::font-ascent font)))
+	;;--rounding errors?
+	;;--Well we do some arithmetic in some cases
+	;;--so in theory it could go wrong.
 	(convert-to-device-coordinates transform x y)
 	(discard-illegal-coordinates medium-draw-text* x y)
 	(when towards-x
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index 202c76dfc0b0618c515fbedcf5cd0e50dc024ace..e642ab93279b48b428849a9445e7faa29354b2f2 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.87 1993/08/12 16:05:13 cer Exp $
+;; $fiHeader: xt-silica.lisp,v 1.88 1993/09/07 21:47:28 colin Exp $
 
 (in-package :xm-silica)
 
@@ -255,11 +255,14 @@
 
 (defmethod destroy-mirror :after ((port xt-port) (sheet sheet-parent-mixin))
   (labels ((loose-em (sheet)
-	   (dolist (child (sheet-children sheet))
-	     (when (sheet-direct-mirror child)
-	       (setf (sheet-direct-mirror child) nil))
-	     (when (typep child 'sheet-parent-mixin)
-	       (loose-em child)))))
+	     (dolist (child (sheet-children sheet))
+	       (let ((m (sheet-direct-mirror child)))
+		 (when m
+		   (setf (silica::mirror->sheet port m) nil
+			 (sheet-direct-mirror child) nil)))
+	       (when (typep child 'sheet-parent-mixin)
+		 (loose-em child)))))
+    (declare (dynamic-extent #'loose-em))
     (loose-em sheet)))
 
 (defmethod realize-widget-mirror ((port xt-port) (parent-sheet t) parent-widget sheet)
@@ -475,6 +478,22 @@
 	:region (untransform-region (sheet-native-transformation sheet) r)
 	:sheet sheet))))
 
+;;-- Perhaps this method should be for any mirrored composite
+;;-- sheet?
+
+
+(defun sheet-mirrored-ancestor-of-clim-stream-sheet-p (sheet)
+  (labels ((walk-children (sheet)
+	     (dolist (child (sheet-children sheet))
+	       (typecase child
+		 (clim-stream-sheet
+		  (return-from sheet-mirrored-ancestor-of-clim-stream-sheet-p t))
+		 (mirrored-sheet-mixin nil)
+		 (sheet-parent-mixin
+		  (walk-children child))))))
+    (declare (dynamic-extent #'walk-children))
+    (walk-children sheet)))
+
 (defmethod sheet-mirror-exposed-callback (widget window event sheet)
   ;; This isn't really the right place to do this, but it's better than
   ;; in ensure-blinker-for-cursor.
@@ -483,8 +502,10 @@
 	  (and port (port-safe-backing-store port)))
     (let ((window (tk::widget-window widget)))
       (unless (getf (window-property-list window) 'backing-store-on)
-	(setf (getf (window-property-list window) 'backing-store-on) t
-	      (xt::window-backing-store window)                      t))))
+	(let ((x (sheet-mirrored-ancestor-of-clim-stream-sheet-p sheet)))
+	  (setf (getf (window-property-list window) 'backing-store-on)
+	    (if x :yes :no))
+	  (when x (setf (xt::window-backing-store window) :when-mapped))))))
   (let* ((minx (x11::xexposeevent-x event))
 	 (miny (x11::xexposeevent-y event))
 	 (width (x11::xexposeevent-width event))
diff --git a/tk/event.lisp b/tk/event.lisp
index 34be364ffb1748e18fd4660db3e0d296a5ec8d30..0ba0197340e91968b5f908e5836aed531773f415 100644
--- a/tk/event.lisp
+++ b/tk/event.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: event.lisp,v 1.18 1993/05/25 20:42:16 cer Exp $
+;; $fiHeader: event.lisp,v 1.20 1993/08/31 04:54:47 layer Exp $
 
 (in-package :tk)
 
@@ -46,9 +46,14 @@
 
 
 (defun wait-for-event (context &key timeout wait-function)
+  (let ((mask 0))
+    (if (plusp (setq mask (xt_app_pending context)))
+	(values mask nil)
+      (wait-for-event-1 context timeout wait-function))))
+
+(defun wait-for-event-1 (context timeout wait-function)
   (let* ((mask 0)
-	 (fds (mapcar #'(lambda (display)
-			  (x11::display-fd display))
+	 (fds (mapcar #'(lambda (display) (x11::display-fd display))
 		      (application-context-displays context)))
 	 result
 	 (reason nil))
@@ -63,6 +68,7 @@
 		       (and wait-function
 			    (funcall wait-function)
 			    (setq reason :wait))))))))
+      
       (let* ((interval (xt_app_interval_next_timer context))
 	     (new-timeout (if (plusp interval)
 			      (if (and timeout
@@ -72,17 +78,12 @@
 				    (truncate interval 1000)
 				  (cons sec msec)))
 			    timeout)))
-	(unless (plusp (setq mask (xt_app_pending context)))
-	  (unless
-	      (mp:wait-for-input-available fds :wait-function #'wait-function
-					   :timeout new-timeout)
-	    (setq mask (xt_app_pending context))))))
-
-    
+	(unless (mp:wait-for-input-available fds 
+					     :wait-function #'wait-function
+					     :timeout new-timeout)
+	  (setq mask (xt_app_pending context)))))
     (values mask reason)))
 
-
-
 (defun process-one-event (context mask reason)
   (cond ((plusp mask)
 
diff --git a/tk/gcontext.lisp b/tk/gcontext.lisp
index d455df5d1331b4855d5979417c0c418c1115f988..e21b06fe7633b64355809ddeb774a3008469565c 100644
--- a/tk/gcontext.lisp
+++ b/tk/gcontext.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: gcontext.lisp,v 1.23 93/04/08 13:18:39 colin Exp $
+;; $fiHeader: gcontext.lisp,v 1.24 1993/07/27 01:52:55 colin Exp $
 
 (in-package :tk)
 
@@ -100,6 +100,15 @@
 			(error "Cannot find ~S in gcontext components" name)))
 	    gc-values)
 	   nv))))
+  
+  (defmacro define-gc-writer-function (name function encoder &rest args)
+    `(progn
+       (defmethod (setf ,(intern (format nil "~A-~A" 'gcontext name)))
+	   (nv (gc gcontext))
+	 (,function
+	  (object-display gc)
+	  gc
+	  (,encoder gc nv ,@args)))))
 
   (defmacro define-gc-reader (name decoder &rest args)
     `(defmethod ,(intern (format nil "~A-~A" 'gcontext name)) ((gc gcontext))
@@ -180,11 +189,12 @@
 
 ;;; Accessors for the gc
 
-(define-gc-accessor function (encode-function decode-function))
-(define-gc-accessor plane-mask (encode-card32 decode-card32))
+(define-gc-reader function decode-function)
 
-;(define-gc-accessor foreground (encode-pixel decode-pixel))
-;(define-gc-accessor background  (encode-pixel decode-pixel))
+(define-gc-writer-function function x11:xsetfunction encode-function)
+
+(define-gc-reader plane-mask decode-card32)
+(define-gc-writer-function plane-mask x11:xsetplanemask encode-card32)
 
 (defmethod gcontext-foreground ((gc gcontext))
   (decode-pixel gc (x11::_xgc-values-foreground gc)))
@@ -236,9 +246,14 @@
    (encode-fill-style gc nv)))
   
 
-(define-gc-accessor fill-rule (encode-enum decode-enum) '(:even-odd :winding))
-(define-gc-accessor tile  (encode-pixmap decode-pixmap))
-(define-gc-accessor stipple  (encode-pixmap decode-pixmap))
+(define-gc-reader fill-rule decode-enum '(:even-odd :winding))
+(define-gc-writer-function fill-rule x11:xsetfillrule encode-enum '(:even-odd :winding))
+
+(define-gc-reader tile decode-pixmap)
+(define-gc-writer-function tile x11:xsettile encode-pixmap)
+
+(define-gc-reader stipple decode-pixmap)
+(define-gc-writer-function stipple x11:xsetstipple encode-pixmap)
 
 (defun encode-pixmap (gc x)
   (declare (ignore gc))
@@ -248,7 +263,9 @@
 (define-gc-accessor ts-y-origin (encode-int16  decode-int16))
 
    
-(define-gc-accessor font (encode-font decode-font))
+(define-gc-reader font decode-font)
+(define-gc-writer-function font x11:xsetfont encode-font)
+
 (define-gc-accessor cap-style (encode-cap-style decode-cap-style))
 
 (defun encode-cap-style (gc x)
diff --git a/tk/graphics.lisp b/tk/graphics.lisp
index 1138951a3bdf7a0e3c7770749d35fd24d6f7d439..7f8084b72c0f521d34ab6167094d565b9c7442f8 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.13 92/12/16 16:50:26 cer Exp $
+;; $fiHeader: graphics.lisp,v 1.14 1993/07/27 01:52:59 colin Exp $
 
 (in-package :tk)
 
@@ -72,6 +72,7 @@
 			 (round (sqrt s-2)))))))
     (setq start-angle (round (* start-angle (/ (* 360 64) (* 2 pi)))))
     (setq end-angle (round (* end-angle (/ (* 360 64) (* 2 pi)))))
+    ;;--rounding
     (if (> end-angle start-angle)
 	(setq end-angle (- end-angle start-angle))
       (setq end-angle (- start-angle end-angle)))
@@ -80,6 +81,7 @@
 	 (object-display drawable)
 	 drawable
 	 gcontext
+	 ;;--rounding
 	 (- center-x x-radius)
 	 (- center-y y-radius)
 	 (* 2 x-radius)
@@ -89,6 +91,7 @@
        (object-display drawable)
        drawable
        gcontext
+       ;;--rounding
        (- center-x x-radius)
        (- center-y y-radius)
        (* 2 x-radius)
diff --git a/tk/make-widget.lisp b/tk/make-widget.lisp
index adbfa2efceef89705beaaaa701468a1427e9ea4d..1ece2ad69d9047d46168052066f9056082cdca6f 100644
--- a/tk/make-widget.lisp
+++ b/tk/make-widget.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: make-widget.lisp,v 1.7 92/11/20 08:46:13 cer Exp $
+;; $fiHeader: make-widget.lisp,v 1.8 1993/07/27 01:53:14 colin Exp $
 
 (in-package :tk)
 
@@ -50,12 +50,18 @@
 
 ;; Where should this go??
 
-(defmacro define-widget-accessor (name class resource)
-  `(progn
-     (defmethod ,name ((widget ,class))
-       (get-values widget ,resource))
-     (defmethod (setf ,name) (nv (widget ,class))
-       (set-values widget ,resource nv))))
+;(defmacro define-widget-accessor (name class resource)
+;  `(progn
+;     (define-widget-reader ,name ,class ,resource)
+;     (define-widget-writer ,name ,class ,resource)))
+;
+;(defmacro define-widget-writer (name class resource)
+;  `(defmethod (setf ,name) (nv (widget ,class))
+;     (set-values widget ,resource nv)))
 
-(define-widget-accessor widget-children composite :children)
-(define-widget-accessor widget-num-children composite :num-children)
+(defmacro define-widget-reader (name class resource)
+  `(defmethod ,name ((widget ,class))
+     (get-values widget ,resource)))
+
+(define-widget-reader widget-children composite :children)
+(define-widget-reader widget-num-children composite :num-children)
diff --git a/tk/pkg.lisp b/tk/pkg.lisp
index 929ed165d266e599dacb1a26c8c475e107d392db..783c73d7ad624d0d11844675b94020955f9d134b 100644
--- a/tk/pkg.lisp
+++ b/tk/pkg.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: pkg.lisp,v 1.14 92/10/02 15:17:59 cer Exp $
+;; $fiHeader: pkg.lisp,v 1.16 1993/08/31 04:54:50 layer Exp $
 
 (defpackage :tk
   ;;-- No we really need
@@ -50,4 +50,4 @@
    #:window-property-list
    ))
 
-(in-package :tk)
+(setf (package-definition-lock (find-package :tk)) t)
diff --git a/tk/widget.lisp b/tk/widget.lisp
index 0f6a6af7670d70efa70b5b81b89807e36e3942d9..5560f24a81f8ea1f154f7ed6c01127e63c505c21 100644
--- a/tk/widget.lisp
+++ b/tk/widget.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: widget.lisp,v 1.31 1993/07/27 01:53:43 colin Exp $
+;; $fiHeader: widget.lisp,v 1.32 1993/08/12 16:04:46 cer Exp $
 
 (in-package :tk)
 
@@ -47,9 +47,15 @@
 	    args))))
 
 ;; These are so we don't need the foreign functions at run time.
+
+(defvar *widget-count* 0)
+
 (defun xt-create-widget (name class parent args num-args)
+  (incf *widget-count*)
   (xt_create_widget name class parent args num-args))
+
 (defun xt-create-managed-widget (name class parent args num-args)
+  (incf *widget-count*)
   (xt_create_managed_widget name class parent args num-args))
 
 (defun create-widget (name widget-class parent &rest args)
@@ -111,6 +117,7 @@
   (let* ((class (find-class-maybe widget-class))
 	 (handle (class-handle class))
 	 (arglist (make-arglist-for-class class parent args)))
+    (incf *widget-count*)
     (xt_create_popup_shell
      ;;-- allocate-no-free
      (string-to-char* name)
diff --git a/tk/xlib.lisp b/tk/xlib.lisp
index 13518963376ce752b406af71dbcdccb5126c0683..b6924c5def9ddddcb4a207c5cc378f6fdb1acc5e 100644
--- a/tk/xlib.lisp
+++ b/tk/xlib.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xlib.lisp,v 1.47 1993/07/27 01:53:47 colin Exp $
+;; $fiHeader: xlib.lisp,v 1.48 1993/08/12 16:04:48 cer Exp $
 
 (in-package :tk)
 
@@ -168,6 +168,8 @@
   
 (defmethod initialize-instance :after
 	   ((p pixmap) &key foreign-address width height depth drawable)
+  (assert (and (plusp width) (plusp height))
+      () "Width and height must be greater than zero")
   (with-slots (display) p
     (setf display (object-display drawable))
     (unless foreign-address
diff --git a/tk/xm-funs.lisp b/tk/xm-funs.lisp
index 8582bff17257bcb7e0e896905a81716308510bb1..8d51a90d7c87890910505a83cc16952bbb1bfc70 100644
--- a/tk/xm-funs.lisp
+++ b/tk/xm-funs.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-funs.lisp,v 1.12 1993/07/27 01:54:04 colin Exp $
+;; $fiHeader: xm-funs.lisp,v 1.13 1993/08/12 16:04:52 cer Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -205,7 +205,7 @@
 (defforeign 'xm_toggle_button_set_state
     :entry-point (ff:convert-to-lang "XmToggleButtonSetState")
     :call-direct t
-    :callback nil
+    :callback t
     :arguments '(foreign-address fixnum fixnum)
     :arg-checking nil
     :return-type :void)
@@ -213,7 +213,7 @@
 (defforeign 'xm_toggle_button_get_state
     :entry-point (ff:convert-to-lang "XmToggleButtonGetState")
     :call-direct t
-    :callback nil
+    :callback t
     :arguments '(foreign-address)
     :arg-checking nil
     :return-type :fixnum)
diff --git a/utils/clim-streams.lisp b/utils/clim-streams.lisp
index 7ab28f030f6a60bc199a8bc3ae5ff81822c97687..6097aa4b53f64c891ca1bcf6079b5006308ad90f 100644
--- a/utils/clim-streams.lisp
+++ b/utils/clim-streams.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clim-streams.lisp,v 1.8 92/11/06 19:04:55 cer Exp $
+;; $fiHeader: clim-streams.lisp,v 1.9 1993/07/27 01:56:48 colin Exp $
 
 (in-package :clim-utils)
 
@@ -35,6 +35,7 @@
   nil)
 
 (defun encapsulating-stream (stream)
+  (declare (special *original-stream*)) ;;-- fwd reference
   (if (and *original-stream*
 	   (stream-encapsulates-stream-p *original-stream* stream))
       *original-stream*
diff --git a/utils/clos-patches.lisp b/utils/clos-patches.lisp
index 44618018e8cee2ac65f08f4f559ffdcf600dcd0b..fbe00d9fe09671c9650b3cb2dc3a3a64d7428042 100644
--- a/utils/clos-patches.lisp
+++ b/utils/clos-patches.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clos-patches.lisp,v 1.7 92/09/08 15:16:58 cer Exp $
+;; $fiHeader: clos-patches.lisp,v 1.8 1993/06/02 18:42:42 cer Exp $
 
 (in-package :clim-utils)
 
@@ -145,3 +145,6 @@
 		     (fix-tree (cdr tree) nil)))
 	     (otherwise tree))))
 	(fix-tree expansion)))))
+
+
+
diff --git a/utils/packages.lisp b/utils/packages.lisp
index ebde891f74bcd2b76d698f29bf822528aa89ac1f..c27fb14f5fc18a53419e4552d1a34eace80b520e 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.57 1993/08/12 16:05:20 cer Exp $
+;; $fiHeader: packages.lisp,v 1.58 1993/09/07 21:47:44 colin Exp $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user)
 
@@ -10,7 +10,7 @@
 ;; Define the CLIM-LISP package, a package designed to mimic ANSI Common Lisp
 ;; as closely as possible (including CLOS).
 (#-(or ANSI-90 Lucid) clim-lisp::defpackage #+(or ANSI-90 Lucid) defpackage clim-lisp
-
+   #+Allegro (:implementation-packages :clim-lisp :clim-utils)
  (:use #-ANSI-90 lisp #+ANSI-90 common-lisp
        #+Allegro clos
        #+(and CLIM-uses-lisp-stream-classes Allegro) stream)
@@ -1506,6 +1506,13 @@
 ;; Define the CLIM package
 (#-(or ANSI-90 Lucid) clim-lisp::defpackage #+(or ANSI-90 Lucid) defpackage clim
   (:use)				;use nothing
+  #+Allegro (:implementation-packages 
+	     :silica 
+	     :clim-utils 
+	     :clim-silica 
+	     :clim-internals
+	     :postscript-clim
+	     :xm-silica)
   (:import-from clim-lisp
     and
     character
@@ -3025,6 +3032,8 @@
 
 ;; Now define all of the implementation packages
 (#-(or ANSI-90 Lucid) clim-lisp::defpackage #+(or ANSI-90 Lucid) defpackage clim-utils
+   #+Allegro (:implementation-packages :clim-utils :clim-silica
+				       :clim-internals :xt-silica)
   (:use	clim-lisp clim-sys clim)
 
   #+Genera
@@ -3342,7 +3351,8 @@
 
 
 (#-(or ANSI-90 Lucid) clim-lisp::defpackage #+(or ANSI-90 Lucid) defpackage clim-silica
-  (:nicknames silica pyrex)
+   (:nicknames silica pyrex)
+   #+Allegro (:implementation-packages :clim-silica :clim-internals :xt-silica)
   (:use	clim-lisp clim-sys clim clim-utils)
 
   #+CCL-2
@@ -3592,8 +3602,8 @@
 
 
 (#-(or ANSI-90 Lucid) clim-lisp::defpackage #+(or ANSI-90 Lucid) defpackage clim-internals
-  (:use	clim-lisp clim-sys clim clim-utils clim-silica)
-
+  (:use	:clim-lisp :clim-sys :clim :clim-utils :clim-silica)
+  #+Allegro (:implementation-packages :clim-internals :xt-silica)
   #+CCL-2
   (:shadowing-import-from clim-utils
     char=
@@ -3628,3 +3638,17 @@
 ;  (when (boundp symbol)
 ;    (dolist (sym '(clim:beep))
 ;      (push sym (symbol-value symbol)))))
+
+
+#+Allegro
+(flet ((lock-package (package)
+	 (setq package (find-package package))
+	 (setf (package-definition-lock package) t)))
+  (mapcar #'lock-package '(
+			   ;;-- We gotta fix the make-pane problem
+			   ;;-- first
+			   ;; clim
+			   clim-utils 
+			   clim-silica
+			   clim-internals 
+			   clim-lisp)))
diff --git a/utils/processes.lisp b/utils/processes.lisp
index 22f5ddef7067c30c6bb429a8e232eae1016536b2..3678ec718c93bb88f1915f167c9cf41911adf924 100644
--- a/utils/processes.lisp
+++ b/utils/processes.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: processes.lisp,v 1.14 92/12/14 15:05:07 cer Exp $
+;; $fiHeader: processes.lisp,v 1.16 1993/08/31 04:55:10 layer Exp $
 
 (in-package :clim-utils)
 
@@ -8,13 +8,14 @@
  Portions copyright (c) 1988, 1989, 1990 International Lisp Associates.
  Portions copyright (c) 1992, 1993 Franz, Inc."
 
+
+;;; Locks
+
 #+allegro
 (eval-when (compile load eval)
   (require :mdproc)
   (require :process))
 
-;;; Locks
-
 (defvar *multiprocessing-p* 
   #{
     (or Allegro Genera Lucid Lispworks Minima) t