diff --git a/cloe/cloe-dc.lisp b/cloe/cloe-dc.lisp
index 63e2c35b35985032c77b4fa38412ebb562b141d0..7e2b5d6b722c9a454eb1fc2c8673595807d2cc15 100644
--- a/cloe/cloe-dc.lisp
+++ b/cloe/cloe-dc.lisp
@@ -1,42 +1,26 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cloe-dc.lisp,v 1.1 92/10/01 10:03:56 cer Exp $
+;; $fiHeader: cloe-dc.lisp,v 1.1 92/10/28 09:24:09 cer Exp $
 
 (in-package :cloe-clim)
 
 "Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved."
 
-
-(eval-when (compile load eval)
-;; Define the new key chars for Cloe CLIM.  Regular Cloe defines 0-127, we define
-;; 128-139 as the F-keys (F1 thru F12), 140 for c-sh-A, and 141 as c-sh-V
-(sys::define-character-name "F1" 128)
-(sys::define-character-name "F2" 129)
-(sys::define-character-name "F3" 130)
-(sys::define-character-name "F4" 131)
-(sys::define-character-name "F5" 132)
-(sys::define-character-name "F6" 133)
-(sys::define-character-name "F7" 134)
-(sys::define-character-name "F8" 135)
-(sys::define-character-name "F9" 136)
-;; Note windows traps F10 as alt-space. Why?
-(sys::define-character-name "F10" 137)
-(sys::define-character-name "F11" 138)
-(sys::define-character-name "F12" 139)
-(sys::define-character-name "Arglist" 140)
-(sys::define-character-name "ShowValue" 141)
-)	;eval-when
-
-;;;
-
+(defvar *dummy-window*)
 (defvar *dc*)
 
+(defvar *current-window*)
 (defvar *current-pen*)
 (defvar *current-brush*)
 (defvar *current-rop2*)
 (defvar *current-background-color*)
 (defvar *current-text-color*)
 (defvar *current-font*)
+(defvar *current-region*)
+(defvar *current-left*)
+(defvar *current-top*)
+(defvar *current-right*)
+(defvar *current-bottom*)
 
 ;;; Stock objects
 (defvar *null-pen*)
@@ -51,8 +35,8 @@
 (defvar *color-to-image* (make-hash-table))
 (defvar *black-image*)
 (defvar *white-image*)
-
 (defvar *ink-to-image* (make-hash-table))
+(defvar *rectangle-to-region* (make-hash-table :test #'equal))
 
 
 (defstruct (dc-image (:predicate nil))
@@ -68,7 +52,10 @@
   (unless win::*windows-channel*
     (win::connect-to-winfe))
   ;; Dummy window to represent class.
-  (setf *dc* (win::create-window "Vanilla" "CLIM" win::ws_popup 0 0 0 0 0 0 0 "arg"))
+  (setf *dummy-window*
+	(win::create-window "Vanilla" "CLIM" win::ws_popup 0 0 0 0 0 0 0 "arg"))
+  (setf *current-window* *dummy-window*)
+  (setf *dc* (win::get-dc *dummy-window*))
 
   ;; Stock objects
   (setf *null-pen* (win::get-stock-object win::null_pen))
@@ -85,7 +72,15 @@
   (setf *current-background-color* #xffffff)
   (setf *current-text-color* #x000000)
   (setf *current-font* nil)
-
+  (setf *current-region* nil)
+  (setf *current-left* nil)
+  (setf *current-top* nil)
+  (setf *current-right* nil)
+  (setf *current-bottom* nil)
+
+  (clrhash *color-to-image*)
+  (clrhash *ink-to-image*)
+  (clrhash *rectangle-to-region*)
   (setf *black-image*
 	(make-dc-image :solid-1-pen *black-pen* :brush *black-brush*
 		       :text-color #x000000 :background-color nil))
@@ -98,6 +93,45 @@
 
 ;;;
 
+(defun select-window (window)
+  (unless (eql *current-window* window)
+    (win::release-dc *dc*)
+    (setf *dc* (win::get-dc window))
+    (setf *current-window* window)
+    (setf *current-region* nil)			;???
+    (setf *current-left* nil))			;???
+  *dc*)
+
+#||
+(defun select-clip-rectangle (left top right bottom)
+  (unless (and (eql *current-left* left)
+	       (eql *current-top* top)
+	       (eql *current-right* right)
+	       (eql *current-bottom* bottom))
+    #||
+    (when *current-left*
+      (win::release-dc *dc*)
+      (setf *dc* (win::get-dc *current-window*)))
+    (win::intersect-clip-rect *dc* left top right bottom)
+    ||#
+    (setf *current-left* left)
+    (setf *current-top* top)
+    (setf *current-right* right)
+    (setf *current-bottom* bottom)))
+||#
+
+(defun select-clip-rectangle (left top right bottom)
+  (select-region (with-stack-list (key left top right bottom)
+		   (or (gethash key *rectangle-to-region*)
+		       (setf (gethash (copy-list key) *rectangle-to-region*)
+			     (win::create-rect-rgn left top right bottom))))))  
+
+(defun select-region (region)
+  (unless (eql *current-region* region)
+    (win::select-region *dc* region)
+    (setf *current-region* region))
+  region)  
+
 (defun select-pen (pen)
   (unless (eql *current-pen* pen)
     (win::select-pen *dc* pen)
diff --git a/cloe/cloe-frames.lisp b/cloe/cloe-frames.lisp
index ae86cfdc0105f3533d23d4edfcbe7f4d32de1266..97e8b5d4bb9ccc5a70494ecb2def4c67aa100435 100644
--- a/cloe/cloe-frames.lisp
+++ b/cloe/cloe-frames.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cloe-frames.lisp,v 1.1 92/10/01 10:03:49 cer Exp $
+;; $fiHeader: cloe-frames.lisp,v 1.2 92/10/28 11:32:23 cer Exp $
 
 (in-package :cloe-clim)
 
@@ -11,8 +11,8 @@
     ()
   (:default-initargs :dialog-view +textual-dialog-view+))
 
-(defmethod make-frame-manager ((port cloe-port) &key)
-  (make-instance 'cloe-frame-manager :port port))
+(defmethod make-frame-manager ((port cloe-port) &key palette)
+  (make-instance 'cloe-frame-manager :port port :palette palette))
 
 (defmethod frame-wrapper ((framem cloe-frame-manager) 
 			  (frame standard-application-frame) pane)
diff --git a/cloe/cloe-medium.lisp b/cloe/cloe-medium.lisp
index 10e1a6186b30db869564089ff7dbe77d5c56ffd5..11915efc91b5806668ac93a9ae281aee6b54afef 100644
--- a/cloe/cloe-medium.lisp
+++ b/cloe/cloe-medium.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cloe-medium.lisp,v 1.1 92/10/01 10:03:52 cer Exp $
+;; $fiHeader: cloe-medium.lisp,v 1.2 92/10/28 11:32:26 cer Exp $
 
 (in-package :cloe-clim)
 
@@ -8,31 +8,15 @@
 
 
 (defclass cloe-medium (basic-medium)
-    ((window :initform nil :reader medium-drawable)
-     (background-dc-image)
+    ((background-dc-image)
      (foreground-dc-image)))
 
-(defmethod make-medium ((port cloe-port) sheet)
-  (make-instance 'cloe-medium
-    :port port
-    :sheet sheet))
-
-(defmethod deallocate-medium :after (port (medium cloe-medium))
+(defmethod engraft-medium :after ((medium cloe-medium) port sheet)
   (declare (ignore port))
-  (with-slots (window) medium
-    (setf window nil)))
-
-(defmethod engraft-medium :after ((medium cloe-medium) (port cloe-port) sheet)
-  (with-slots (window background-dc-image foreground-dc-image) medium
-    (unless window
-      (setq window (sheet-mirror sheet)))
+  (with-slots (background-dc-image foreground-dc-image) medium
     (setf background-dc-image (dc-image-for-ink medium (medium-background medium)))
     (setf foreground-dc-image (dc-image-for-ink medium (medium-foreground medium)))))
 
-(defmethod degraft-medium :after ((medium cloe-medium) (port cloe-port) sheet)
-  (declare (ignore sheet))
-  nil)
-
 (defmethod (setf medium-background) :after (new-background (medium cloe-medium))
   (with-slots (background-dc-image) medium
     (setf background-dc-image (dc-image-for-ink medium new-background))))
@@ -41,6 +25,52 @@
   (with-slots (foreground-dc-image) medium
     (setf foreground-dc-image (dc-image-for-ink medium new-foreground))))
 
+;;;
+
+(defclass cloe-window-medium (cloe-medium)
+    ((window :initform nil :reader medium-drawable)))
+
+(defmethod make-medium ((port cloe-port) sheet)
+  (make-instance 'cloe-window-medium
+    :port port
+    :sheet sheet))
+
+(defmethod engraft-medium :after ((medium cloe-window-medium) port sheet)
+  (declare (ignore port))
+  (with-slots (window) medium
+    (unless window
+      (setq window (sheet-mirror sheet)))))
+
+(defmethod degraft-medium :after ((medium cloe-window-medium) port sheet)
+  (declare (ignore port sheet))
+  (with-slots (window) medium
+    (setf window nil))
+  nil)
+
+(defmethod select-cloe-dc ((medium cloe-window-medium))
+  (let* ((sheet (medium-sheet medium))
+	 (region (sheet-device-region sheet))
+	 (medium-region (medium-clipping-region medium))
+	 cleft ctop cright cbottom
+	 (valid nil))
+    (unless (eq region +nowhere+)
+      (multiple-value-setq (cleft ctop cright cbottom) (bounding-rectangle* region))
+      (setf valid t)
+      (unless (eq medium-region +everywhere+)
+	(with-bounding-rectangle* (mleft mtop mright mbottom) medium-region
+	  (multiple-value-setq (valid cleft ctop cright cbottom)
+	    (multiple-value-call #'ltrb-overlaps-ltrb-p
+				 cleft ctop cright cbottom
+				 (transform-rectangle* 
+				   (sheet-device-transformation sheet)
+				   mleft mtop mright mbottom))))))
+    (when valid
+      (fix-coordinates cleft ctop cright cbottom)
+      (with-slots (window) medium
+	(select-window window))
+      (select-clip-rectangle cleft ctop cright cbottom))
+    valid))
+
 
 
 (defmethod dc-image-for-ink (medium (ink (eql +foreground-ink+)))
@@ -154,83 +184,80 @@
   (dc-image-for-ink medium (make-color-for-contrasting-ink ink)))
 
 
-(defmethod invoke-with-clipping-region ((medium cloe-medium) continuation region)
-  (funcall continuation medium))
-
 (defmethod medium-draw-point* ((medium cloe-medium) x y)
-  (let* ((sheet (medium-sheet medium))
-	 (transform (sheet-device-transformation sheet))
-	 (ink (medium-ink medium))
-	 (line-style (medium-line-style medium))
-	 (drawable (medium-drawable medium)))
-    (convert-to-device-coordinates transform x y)
-    (set-dc-for-ink medium ink line-style)
-    (win::rectangle drawable x y x y)))
+  (when (select-cloe-dc medium)
+    (let* ((sheet (medium-sheet medium))
+	   (transform (sheet-device-transformation sheet))
+	   (ink (medium-ink medium))
+	   (line-style (medium-line-style medium)))
+      (convert-to-device-coordinates transform x y)
+      (set-dc-for-ink medium ink line-style)
+      (win::rectangle *dc* x y x y))))
 
 (defmethod medium-draw-points* ((medium cloe-medium) position-seq)
   (nyi))
 
 (defmethod medium-draw-line* ((medium cloe-medium) x1 y1 x2 y2)
-  (let* ((sheet (medium-sheet medium))
-	 (transform (sheet-device-transformation sheet))
-	 (ink (medium-ink medium))
-	 (line-style (medium-line-style medium))
-	 (drawable (medium-drawable medium)))
-    (convert-to-device-coordinates transform x1 y1 x2 y2)
-    (set-dc-for-ink medium ink line-style)
-    (win::move-to drawable x1 y2)
-    (win::line-to drawable x2 y2)))
+  (when (select-cloe-dc medium)
+    (let* ((sheet (medium-sheet medium))
+	   (transform (sheet-device-transformation sheet))
+	   (ink (medium-ink medium))
+	   (line-style (medium-line-style medium)))
+      (convert-to-device-coordinates transform x1 y1 x2 y2)
+      (set-dc-for-ink medium ink line-style)
+      (win::move-to *dc* x1 y2)
+      (win::line-to *dc* x2 y2))))
 
 (defmethod medium-draw-lines* ((medium cloe-medium) position-seq)
   (nyi))
 
 (defmethod medium-draw-rectangle* ((medium cloe-medium)
 				   left top right bottom filled)
-  (let* ((sheet (medium-sheet medium))
-	 (transform (sheet-device-transformation sheet))
-	 (ink (medium-ink medium))
-	 (line-style (medium-line-style medium))
-	 (drawable (medium-drawable medium)))
-    (convert-to-device-coordinates transform
-      left top right bottom)
-    (when (< right left) (rotatef right left))
-    (when (< bottom top) (rotatef bottom top))
-    (set-dc-for-ink medium ink line-style)
-    (win::rectangle drawable left top right bottom)))
+  (when (select-cloe-dc medium)
+    (let* ((sheet (medium-sheet medium))
+	   (transform (sheet-device-transformation sheet))
+	   (ink (medium-ink medium))
+	   (line-style (and (not filled) (medium-line-style medium))))
+      (convert-to-device-coordinates transform
+	left top right bottom)
+      (when (< right left) (rotatef right left))
+      (when (< bottom top) (rotatef bottom top))
+      (set-dc-for-ink medium ink line-style)
+      (win::rectangle *dc* left top right bottom))))
 
 (defmethod medium-draw-rectangles* ((medium cloe-medium) position-seq filled)
   (nyi))
 
 (defmethod medium-draw-polygon* ((medium cloe-medium) position-seq closed filled)
-  (let* ((sheet (medium-sheet medium))
-	 (transform (sheet-device-transformation sheet))
-	 (ink (medium-ink medium))
-	 (line-style (medium-line-style medium))
-	 (drawable (medium-drawable medium))
-	 (minx most-positive-fixnum)
-	 (miny most-positive-fixnum)
-	 (length (length position-seq)))
-    ;; These really are fixnums, since we're fixing coordinates below
-    (declare (type fixnum minx miny))
-    (with-stack-array (points (if (and closed line-style) (+ length 2) length))
-      (declare (type simple-vector points))
-      (replace points position-seq)		;set up the initial contents
-      (do ((i 0 (+ i 2)))
-	  ((>= i length))
-	(let ((x (svref points i))
-	      (y (svref points (1+ i))))
-	  (convert-to-device-coordinates transform x y)
-	  (setf (svref points i) x)
-	  (setf (svref points (1+ i)) y)
-	  (minf minx x)
-	  (minf miny y)))
-      (when (and closed line-style)		;kludge
-	(setf (svref points length) (svref points 0))
-	(setf (svref points (+ length 1)) (svref points 1)))
-      (set-dc-for-ink medium ink line-style)
-      (if (null line-style)
-	  (win::polygon drawable (coerce points 'list))
-	  (win::polyline drawable (coerce points 'list) closed)))))
+  (when (select-cloe-dc medium)
+    (let* ((sheet (medium-sheet medium))
+	   (transform (sheet-device-transformation sheet))
+	   (ink (medium-ink medium))
+	   (line-style (and (not filled) (medium-line-style medium)))
+	   (minx most-positive-fixnum)
+	   (miny most-positive-fixnum)
+	   (length (length position-seq)))
+      ;; These really are fixnums, since we're fixing coordinates below
+      (declare (type fixnum minx miny))
+      (with-stack-array (points (if (and closed line-style) (+ length 2) length))
+	(declare (type simple-vector points))
+	(replace points position-seq)		;set up the initial contents
+	(do ((i 0 (+ i 2)))
+	    ((>= i length))
+	  (let ((x (svref points i))
+		(y (svref points (1+ i))))
+	    (convert-to-device-coordinates transform x y)
+	    (setf (svref points i) x)
+	    (setf (svref points (1+ i)) y)
+	    (minf minx x)
+	    (minf miny y)))
+	(when (and closed line-style)		;kludge
+	  (setf (svref points length) (svref points 0))
+	  (setf (svref points (+ length 1)) (svref points 1)))
+	(set-dc-for-ink medium ink line-style)
+	(if (null line-style)
+	    (win::polygon *dc* (coerce points 'list))
+	    (win::polyline *dc* (coerce points 'list) closed))))))
 
 (defconstant *ft* 0.0001)
 (defun-inline fl-= (x y) (< (abs (- x y)) *ft*))
@@ -239,79 +266,107 @@
 				 center-x center-y
 				 radius-1-dx radius-1-dy radius-2-dx radius-2-dy
 				 start-angle end-angle filled)
-  (let* ((sheet (medium-sheet medium))
-	 (transform (sheet-device-transformation sheet))
-	 (ink (medium-ink medium))
-	 (line-style (medium-line-style medium))
-	 (drawable (medium-drawable medium)))
-    (convert-to-device-coordinates transform center-x center-y)
-    (convert-to-device-distances transform 
-      radius-1-dx radius-1-dy radius-2-dx radius-2-dy)
-    (when (null start-angle)
-      (setq start-angle 0.0
-	    end-angle 2pi))
-    (set-dc-for-ink medium ink line-style)
-    (multiple-value-bind (x-radius y-radius)
-	(cond ((and (= radius-1-dx 0) (= radius-2-dy 0))
-	       (values (abs radius-2-dx) (abs radius-1-dy)))
-	      ((and (= radius-2-dx 0) (= radius-1-dy 0))
-	       (values (abs radius-1-dx) (abs radius-2-dy)))
-	      (t
-	       (let ((s-1 (+ (* radius-1-dx radius-1-dx) (* radius-1-dy radius-1-dy)))
-		     (s-2 (+ (* radius-2-dx radius-2-dx) (* radius-2-dy radius-2-dy))))
-		 (if (= s-1 s-2)
-		     (let ((r (truncate (sqrt s-1))))
-		       (values r r))
-		     ;; Degrade to drawing a rectilinear ellipse
-		     (values (truncate (sqrt s-1)) 
-			     (truncate (sqrt s-2)))))))
-      (let (left top right bottom)
-	(setq left (- center-x x-radius)
-	      right (+ center-x x-radius)
-	      top (- center-y y-radius)
-	      bottom (+ center-y y-radius))
-	(cond ((or (fl-= (- end-angle start-angle) 2pi)
-		   (fl-= (- end-angle start-angle) 0))
-	       #+++ignore
-	       (and (= start-angle 0)
-		    (= end-angle 2pi))
-	       ;; drawing a full ellipse
-	       (win::ellipse drawable left top right bottom))
-	      ((null line-style)
-	       ;; drawing a pie slice
-	       (win::pie drawable left top right bottom
-			 (round (+ (* (cos end-angle) x-radius) center-x))
-			 (round (+ (* (sin end-angle) y-radius) center-y))
-			 (round (+ (* (cos start-angle) x-radius) center-x))
-			 (round (+ (* (sin start-angle) y-radius) center-y))))
-	      (t
-	       ;; drawing an arc
-	       (win::arc drawable left top right bottom
-			 (round (+ (* (cos end-angle) x-radius) center-x))
-			 (round (+ (* (sin end-angle) y-radius) center-y))
-			 (round (+ (* (cos start-angle) x-radius) center-x))
-			 (round (+ (* (sin start-angle) y-radius) center-y)))))))))
+  (when (select-cloe-dc medium)
+    (let* ((sheet (medium-sheet medium))
+	   (transform (sheet-device-transformation sheet))
+	   (ink (medium-ink medium))
+	   (line-style (and (not filled) (medium-line-style medium))))
+      (convert-to-device-coordinates transform center-x center-y)
+      (convert-to-device-distances transform 
+	radius-1-dx radius-1-dy radius-2-dx radius-2-dy)
+      (when (null start-angle)
+	(setq start-angle 0.0
+	      end-angle 2pi))
+      (set-dc-for-ink medium ink line-style)
+      (multiple-value-bind (x-radius y-radius)
+	  (cond ((and (= radius-1-dx 0) (= radius-2-dy 0))
+		 (values (abs radius-2-dx) (abs radius-1-dy)))
+		((and (= radius-2-dx 0) (= radius-1-dy 0))
+		 (values (abs radius-1-dx) (abs radius-2-dy)))
+		(t
+		 (let ((s-1 (+ (* radius-1-dx radius-1-dx) (* radius-1-dy radius-1-dy)))
+		       (s-2 (+ (* radius-2-dx radius-2-dx) (* radius-2-dy radius-2-dy))))
+		   (if (= s-1 s-2)
+		       (let ((r (truncate (sqrt s-1))))
+			 (values r r))
+		       ;; Degrade to drawing a rectilinear ellipse
+		       (values (truncate (sqrt s-1)) 
+			       (truncate (sqrt s-2)))))))
+	(let (left top right bottom)
+	  (setq left (- center-x x-radius)
+		right (+ center-x x-radius)
+		top (- center-y y-radius)
+		bottom (+ center-y y-radius))
+	  (cond ((or (fl-= (- end-angle start-angle) 2pi)
+		     (fl-= (- end-angle start-angle) 0))
+		 #+++ignore
+		 (and (= start-angle 0)
+		      (= end-angle 2pi))
+		 ;; drawing a full ellipse
+		 (win::ellipse *dc* left top right bottom))
+		((null line-style)
+		 ;; drawing a pie slice
+		 (win::pie *dc* left top right bottom
+			   (round (+ (* (cos end-angle) x-radius) center-x))
+			   (round (+ (* (sin end-angle) y-radius) center-y))
+			   (round (+ (* (cos start-angle) x-radius) center-x))
+			   (round (+ (* (sin start-angle) y-radius) center-y))))
+		(t
+		 ;; drawing an arc
+		 (win::arc *dc* left top right bottom
+			   (round (+ (* (cos end-angle) x-radius) center-x))
+			   (round (+ (* (sin end-angle) y-radius) center-y))
+			   (round (+ (* (cos start-angle) x-radius) center-x))
+			   (round (+ (* (sin start-angle) y-radius) center-y))))))))))
 
 (defmethod medium-draw-string* ((medium cloe-medium)
 				string x y start end align-x align-y
 				towards-x towards-y transform-glyphs)
-  (let* ((sheet (medium-sheet medium))
-	 (transform (sheet-device-transformation sheet))
-	 (ink (medium-ink medium))
-	 (text-style (medium-merged-text-style medium))
-	 (drawable (medium-drawable medium)))
-    (convert-to-device-coordinates transform x y)
-    (when towards-x
-      (convert-to-device-coordinates transform towards-x towards-y))
-    (unless end
-      (setq end (length string)))
-    (with-temporary-substring (substring string start end)
+  (when (select-cloe-dc medium)
+    (let* ((sheet (medium-sheet medium))
+	   (transform (sheet-device-transformation sheet))
+	   (ink (medium-ink medium))
+	   (text-style (medium-merged-text-style medium)))
+      (convert-to-device-coordinates transform x y)
+      (when towards-x
+	(convert-to-device-coordinates transform towards-x towards-y))
+      (unless end
+	(setq end (length string)))
+      (with-temporary-substring (substring string start end)
+	(let* ((font (text-style-mapping (port medium) text-style))
+	       (height (cloe-font-height font))
+	       (descent (cloe-font-descent font))
+	       (ascent (cloe-font-ascent font)))
+	  (let ((x-adjust 
+		  (compute-text-x-adjustment align-x medium string text-style start end))
+		(y-adjust
+		  (compute-text-y-adjustment align-y descent ascent height)))
+	    (incf x x-adjust)
+	    (incf y y-adjust)
+	    (when towards-x
+	      (incf towards-x x-adjust)
+	      (incf towards-y y-adjust)))
+	  (decf y ascent)			;text is positioned by its top left on CLOE
+	  (set-dc-for-text medium ink (cloe-font-index font))
+	  (win::text-out *dc* x y substring))))))
+
+(defmethod medium-draw-character* ((medium cloe-medium)
+				   character x y align-x align-y
+				   towards-x towards-y transform-glyphs)
+  (when (select-cloe-dc medium)
+    (let* ((sheet (medium-sheet medium))
+	   (transform (sheet-device-transformation sheet))
+	   (ink (medium-ink medium))
+	   (text-style (medium-merged-text-style medium)))
+      (convert-to-device-coordinates transform x y)
+      (when towards-x
+	(convert-to-device-coordinates transform towards-x towards-y))
       (let* ((font (text-style-mapping (port medium) text-style))
 	     (height (cloe-font-height font))
 	     (descent (cloe-font-descent font))
 	     (ascent (cloe-font-ascent font)))
 	(let ((x-adjust 
-		(compute-text-x-adjustment align-x medium string text-style start end))
+		(compute-text-x-adjustment align-x medium character text-style))
 	      (y-adjust
 		(compute-text-y-adjustment align-y descent ascent height)))
 	  (incf x x-adjust)
@@ -321,37 +376,9 @@
 	    (incf towards-y y-adjust)))
 	(decf y ascent)				;text is positioned by its top left on CLOE
 	(set-dc-for-text medium ink (cloe-font-index font))
-	(win::text-out drawable x y substring)))))
-
-(defmethod medium-draw-character* ((medium cloe-medium)
-				   character x y align-x align-y
-				   towards-x towards-y transform-glyphs)
-  (let* ((sheet (medium-sheet medium))
-	 (transform (sheet-device-transformation sheet))
-	 (ink (medium-ink medium))
-	 (text-style (medium-merged-text-style medium))
-	 (drawable (medium-drawable medium)))
-    (convert-to-device-coordinates transform x y)
-    (when towards-x
-      (convert-to-device-coordinates transform towards-x towards-y))
-    (let* ((font (text-style-mapping (port medium) text-style))
-	   (height (cloe-font-height font))
-	   (descent (cloe-font-descent font))
-	   (ascent (cloe-font-ascent font)))
-      (let ((x-adjust 
-	      (compute-text-x-adjustment align-x medium character text-style))
-	    (y-adjust
-	      (compute-text-y-adjustment align-y descent ascent height)))
-	(incf x x-adjust)
-	(incf y y-adjust)
-	(when towards-x
-	  (incf towards-x x-adjust)
-	  (incf towards-y y-adjust)))
-      (decf y ascent)		;text is positioned by its top left on CLOE
-      (set-dc-for-text medium ink (cloe-font-index font))
-      (with-temporary-string (string :length 1)
-	(vector-push character string)
-	(win::text-out drawable x y string)))))
+	(with-temporary-string (string :length 1)
+	  (vector-push character string)
+	  (win::text-out *dc* x y string))))))
 
 (defmethod medium-draw-text* ((medium cloe-medium)
 			      string-or-char x y start end
@@ -364,11 +391,19 @@
 			   towards-x towards-y transform-glyphs)))
 
 (defmethod medium-clear-area ((medium cloe-medium) left top right bottom)
-  (with-slots (window background-dc-image) medium
-    (set-dc-for-filling background-dc-image)
-    (win::rectangle window left top right bottom)))
+  (when (select-cloe-dc medium)
+    (with-slots (background-dc-image) medium
+      (let* ((sheet (medium-sheet medium))
+	     (transform (sheet-device-transformation sheet)))
+	(convert-to-device-coordinates transform
+	  left top right bottom)
+	(when (< right left) (rotatef right left))
+	(when (< bottom top) (rotatef bottom top))
+	(set-dc-for-filling background-dc-image)
+	(win::rectangle *dc* left top right bottom)))))
 
 
+
 (defmethod text-style-width ((text-style standard-text-style) (medium cloe-medium))
   (let ((font (text-style-mapping (port medium) text-style)))
     (cloe-font-average-character-width font)))
@@ -392,17 +427,15 @@
        (cloe-font-maximum-character-width font))))
 
 
+
 (defmethod medium-beep ((medium cloe-medium))
   (win::message-beep))
 
 (defmethod medium-force-output ((medium cloe-medium))
-  (declare (ignore medium))
   )
 
 (defmethod medium-clear-output ((medium cloe-medium))
-  (declare (ignore medium))
   )
 
 (defmethod medium-finish-output ((medium cloe-medium))
-  (declare (ignore medium))
   )
diff --git a/cloe/cloe-mirror.lisp b/cloe/cloe-mirror.lisp
index 0ce59215306b23e4936f0b46c35dfe4f7d8aa978..ccc2705cbbfcb1f8e99be49339ed5216d5ec4322 100644
--- a/cloe/cloe-mirror.lisp
+++ b/cloe/cloe-mirror.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cloe-mirror.lisp,v 1.1 92/10/01 10:03:54 cer Exp $
+;; $fiHeader: cloe-mirror.lisp,v 1.2 92/10/28 11:32:28 cer Exp $
 
 (in-package :cloe-clim)
 
@@ -14,8 +14,8 @@
 	       silica::mm-width silica::mm-height silica::units) graft
     (multiple-value-bind (screen-width screen-height)
 	(win::get-screen-size)
-      (let ((logpixelsx (win::get-device-caps *dc* 90))
-	    (logpixelsy (win::get-device-caps *dc* 90)))
+      (let ((logpixelsx (win::get-device-caps *dc* win::logpixelsx))
+	    (logpixelsy (win::get-device-caps *dc* win::logpixelsy)))
 	(setf silica::pixel-width  screen-width
 	      silica::pixel-height screen-height
 	      silica::mm-width     (round (* screen-width 25.4s0) logpixelsx)
@@ -31,7 +31,7 @@
 		   0 0 
 		   silica::pixel-width silica::pixel-height))))
 	(setf (sheet-native-transformation graft) +identity-transformation+)
-	(setf (sheet-direct-mirror graft) *dc*)
+	(setf (sheet-direct-mirror graft) 0)
 	(update-mirror-transformation port graft)))))
 
 (defmethod realize-mirror ((port cloe-port) sheet)
@@ -45,7 +45,7 @@
 	      (win::create-window
 		"Vanilla" "CLIM"
 		(logior win::ws_clipchildren	;new, helps refresh
-			(cond ((not (eq parent *dc*))
+			(cond ((not (eql parent 0))
 			       (logior win::ws_child
 				       win::ws_clipsiblings))
 			      (save-under
@@ -60,7 +60,7 @@
 				       win::ws_maximizebox)))
 			)
 		left top (- right left) (- bottom top)
-		(if (eql parent *dc*) 0 parent) 0 0 "arg"))))
+		parent 0 0 "arg"))))
       (setf (sheet-native-transformation sheet) +identity-transformation+)
       window)))
 
@@ -86,18 +86,14 @@
 				    win::swp_nosize)))
 
 (defmethod mirror-visible-p ((port cloe-port) sheet)
-  ;;(win::is-window-visible (sheet-mirror sheet))
-  t)
-
-(defmethod cloe-mirror-native-edges* ((port cloe-port) mirror)
-  (multiple-value-bind (wleft wtop wright wbottom)
-      (win::get-window-rectangle mirror)
-    (values (coordinate wleft) (coordinate wtop)
-	    (coordinate wright) (coordinate wbottom))))
+  (win::is-window-visible (sheet-mirror sheet)))
 
 ;; Returns left,top,right,bottom
 (defmethod mirror-region* ((port cloe-port) sheet)
-  (cloe-mirror-native-edges* port (sheet-mirror sheet)))
+  (multiple-value-bind (cleft ctop cright cbottom)
+      (win::get-client-rectangle (sheet-mirror window))
+    (values (coordinate cleft) (coordinate ctop)
+	    (coordinate cright) (coordinate cbottom))))
 
 ;; Returns x,y,width,height
 (defmethod mirror-inside-region* ((port cloe-port) sheet)
@@ -108,7 +104,10 @@
 
 ;;--- Shouldn't this be the same as MIRROR-REGION*?
 (defmethod mirror-native-edges* ((port cloe-port) sheet)
-  (cloe-mirror-native-edges* port (sheet-direct-mirror sheet)))
+  (multiple-value-bind (cleft ctop cright cbottom)
+      (win::get-client-rectangle (sheet-direct-mirror sheet))
+    (values (coordinate cleft) (coordinate ctop)
+	    (coordinate cright) (coordinate cbottom))))
 
 (defmethod mirror-inside-edges* ((port cloe-port) sheet)
   (multiple-value-bind (cleft ctop cright cbottom)
@@ -120,198 +119,6 @@
   (fix-coordinates left top right bottom)
   (win::set-window-position (sheet-mirror sheet) 0
 			    left top (- right left) (- bottom top)
-			    (logior win::swp_noactivate win::swp_nozorder)))
-
-;;;
-
-(defun-inline sign-extend-16 (n)
-  (dpb n (byte 15 0) (- (ldb (byte 1 15) n))))
-
-(defmethod note-pointer-motion ((port cloe-port) sheet x y)
-  (with-slots (pointer-sheet pointer-x pointer-y) port
-    (setf pointer-sheet sheet)
-    (setf pointer-x x)
-    (setf pointer-y y)))
-
-(defmethod flush-pointer-motion ((port cloe-port))
-  (with-slots (event-queue pointer-sheet pointer-x pointer-y) port
-    (when pointer-sheet
-      (let ((pointer (port-pointer port)))
-	(when pointer
-	  (queue-put event-queue
-		     (allocate-event 'pointer-motion-event
-		       :native-x pointer-x
-		       :native-y pointer-y
-		       :modifier-state (port-modifier-state port)
-		       :pointer pointer
-		       :sheet pointer-sheet))))
-      (setf pointer-sheet nil))))
-
-;;; Convert a MS Windows shift mask into a CLIM modifier-state
-(defun windows-mask->modifier-state (mask)
-  (if (logtest win::mk_shift mask)
-      (if (logtest win::mk_control mask)
-	  (make-modifier-state :shift :control)
-	  (make-modifier-state :shift))
-      (if (logtest win::mk_control mask)
-	  (make-modifier-state :control)
-	  (make-modifier-state))))
-
-(defmethod event-handler ((port cloe-port) args)
-  (with-slots (event-queue pointer-sheet pointer-x pointer-y) port
-    (let ((sheet (mirror->sheet port (win::get-16bit args 0)))
-	  (message (win::get-16bit args 2)))
-      (declare (fixnum message))
-      (when sheet
-	(cond ((eql message win::wm_mousemove)
-	       (note-pointer-motion port sheet (win::get-16bit args 6) (win::get-16bit args 8)))
-
-	      ((eql message win::wm_paint)
-	       (let ((ileft (win::get-16bit args 4))
-		     (itop (win::get-16bit args 6))
-		     (iright (win::get-16bit args 8))
-		     (ibottom (win::get-16bit args 10)))
-		 (unless (or (= ileft iright) (= itop ibottom))	;seems to happen alot
-		   (queue-put event-queue
-			      (allocate-event 'window-repaint-event
-				;;--- Should this be (MIRROR-REGION PORT SHEET), as
-				;;--- it is in the :CONFIGURE-NOTIFY case?
-				:native-region (sheet-native-region sheet)
-				:region (make-bounding-rectangle ileft itop iright ibottom)
-				:sheet sheet)))))
-
-	      #||
-	      ;; scrolling
-	      ((or (eql message win::wm_hscroll) (eql message win::wm_vscroll))
-	       (let ((type (win::get-16bit args 4))
-		     (position (win::get-16bit args 6))
-		     (message (cond ((eql message win::wm_hscroll) :x)
-				    ((eql message win::wm_vscroll) :y))))
-		 (declare (fixnum type position))
-		 (multiple-value-bind (type position)
-		     (cond ((eql type win::sb_lineup)
-			    (values :relative-jump -1))
-			   ((eql type win::sb_linedown)
-			    (values :relative-jump +1))
-			   ((eql type win::sb_pageup)
-			    (values :screenful -1))
-			   ((eql type win::sb_pagedown)
-			    (values :screenful +1))
-			   ((eql type win::sb_thumbposition)
-			    (values :percentage position))
-			   ((eql type win::sb_top)
-			    (values :percentage 0))
-			   ((eql type win::sb_bottom)
-			    (values :percentage 100)))
-		   (when type
-		     (queue-put pending-scrolls (list message type position))
-		     (pushnew stream *cloe-windows-with-deferred-events*)))))
-	      ||#
-
-	      ;; resizing
-	      ((or (eql message win::wm_move)
-		   (eql message win::wm_size))
-	       (queue-put event-queue
-			  (allocate-event 'window-configuration-event
-			    :sheet sheet)))
-
-	      ;; character typed
-	      ((eql message win::wm_char)
-	       (let ((char (aref args 4)))
-		 (flush-pointer-motion port)
-		 (queue-put event-queue
-			    (allocate-event 'key-press-event
-			      :key-name nil
-			      :character char
-			      :modifier-state (port-modifier-state port)
-			      :sheet sheet))))
-
-	      #||
-	      ((or (eql message win::wm_keydown)
-		   (eql message win::wm_keyup)
-		   (eql message win::wm_syskeyup)
-		   (eql message win::wm_syskeydown))
-	       (let ((vk (char-code (aref args 4))))
-		 (flush-pointer-motion port)
-		 (queue-put event-queue
-			    (allocate-event
-			      (cond ((or (eql message win::wm_keydown)
-					 (eql message win::wm_syskeydown))
-				     'key-press-event)
-				    ((or (eql message win::wm_keyup)
-					 (eql message win::wm_syskeyup))
-				     'key-release-event))
-			      :key-name (vk->keysym vk)
-			      :character nil
-			      :modifier-state (port-modifier-state port)
-			      :sheet sheet))))
-	      ||#
-
-	      ;; button press or release
-	      ((or (eql message win::wm_lbuttondown)
-		   (eql message win::wm_rbuttondown)
-		   (eql message win::wm_mbuttondown)
-		   (eql message win::wm_lbuttonup)
-		   (eql message win::wm_rbuttonup)
-		   (eql message win::wm_mbuttonup))
-	       (let ((modifier-state (windows-mask->modifier-state (win::get-16bit args 4)))
-		     (pointer (port-pointer port)))
-		 (when pointer
-		   (flush-pointer-motion port)
-		   (setf (port-modifier-state port) modifier-state)
-		   (multiple-value-bind (key button)
-		       (cond ((eql message win::wm_lbuttondown)
-			      (values 'pointer-button-press-event +pointer-left-button+))
-			     ((eql message win::wm_mbuttondown)
-			      (values 'pointer-button-press-event +pointer-middle-button+))
-			     ((eql message win::wm_rbuttondown)
-			      (values 'pointer-button-press-event +pointer-right-button+))
-			     ((eql message win::wm_lbuttonup)
-			      (values 'pointer-button-release-event +pointer-left-button+))
-			     ((eql message win::wm_mbuttonup)
-			      (values 'pointer-button-release-event +pointer-middle-button+))
-			     ((eql message win::wm_rbuttonup)
-			      (values 'pointer-button-release-event +pointer-right-button+)))
-		     (queue-put event-queue
-				(allocate-event key
-				  :native-x (win::get-16bit args 6)
-				  :native-y (win::get-16bit args 8)
-				  :button button
-				  :modifier-state modifier-state
-				  :pointer pointer
-				  :sheet sheet))))))
-	      )))))
-
-(defun win::vanilla-event (code length args)
-  (declare (ignore code length))		;because I don't know what they are!
-  (event-handler *cloe-port* args))
-
-;;;
-
-(defmethod process-next-event ((port cloe-port)
-			       &key (timeout nil) (wait-function nil)
-			       (state "Windows Event"))
-  (with-slots (event-queue) port
-    (let ((end-time (and timeout (+ (get-internal-real-time)
-				    (* internal-time-units-per-second timeout)))))
-      (win::await-response -1 nil nil)
-      (loop
-	(flush-pointer-motion port)
-	(let ((event (queue-get event-queue)))
-	  (when event
-	    (distribute-event port event)
-	    (return t)))
-	(when (and end-time (> (get-internal-real-time) end-time))
-	  (return nil))
-	(win::await-response -1 t t)))))
-
-(defmethod distribute-event :around ((port cloe-port) (event window-configuration-event))
-  (let* ((sheet (event-sheet event))
-	 (mirror (sheet-mirror sheet)))
-    (unless (win::is-iconic mirror)
-      (let ((native-region (mirror-region port sheet)))
-	(setf (slot-value event 'pyrex::native-region) native-region)
-	(setf (slot-value event 'pyrex::region)
-	      (untransform-region (sheet-native-transformation sheet) 
-				  native-region)))
-      (call-next-method))))
+			    (logior win::swp_nomove	;???
+				    win::swp_noactivate
+				    win::swp_nozorder)))
diff --git a/cloe/cloe-pixmaps.lisp b/cloe/cloe-pixmaps.lisp
index 90ea4dc6da4f69494ff75a3ad2ccaa8a21eabbe8..e4b030fe3c30a28c1780ec66deb4782197c9719c 100644
--- a/cloe/cloe-pixmaps.lisp
+++ b/cloe/cloe-pixmaps.lisp
@@ -1,22 +1,25 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cloe-pixmaps.lisp,v 1.1 92/10/01 10:03:55 cer Exp $
+;; $fiHeader: cloe-pixmaps.lisp,v 1.2 92/10/28 11:32:30 cer Exp $
 
 (in-package :cloe-clim)
 
 "Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved."
 
 
-(defmethod medium-copy-area ((from-medium cloe-medium) from-x from-y width height
-			     (to-medium cloe-medium) to-x to-y)
+(defmethod medium-copy-area ((from-medium cloe-window-medium) from-x from-y width height
+			     (to-medium cloe-window-medium) to-x to-y)
   (unless (eq from-medium to-medium)
     (error "Can't copy."))
+  (when (select-cloe-dc from-medium)
   (let ((transform (sheet-device-transformation (medium-sheet from-medium))))
     (convert-to-device-coordinates transform from-x from-y to-x to-y)
     (convert-to-device-distances transform width height)
-    (let ((x-delta (- to-x from-x))		;can be negative
-	  (y-delta (- to-y from-y)))		;can be negative
-      (win::scroll-dc (medium-drawable from-medium)
-		      x-delta y-delta
-		      from-x from-y (+ from-x width) (+ from-y height) 
-		      0 0 width height))))
+    (let ((left (min from-x to-x))
+	  (top (min from-y to-y))
+	  (right (+ (max from-x to-x) width))
+	  (bottom (+ (max from-y to-y) height)))
+      (win::scroll-dc *dc*
+		      (- to-x from-x) (- to-y from-y)
+		      left top right bottom
+		      left top right bottom)))))
diff --git a/clx/clx-port.lisp b/clx/clx-port.lisp
index ca6de4fe4ed51050f67f27aeb181f61da707c96f..0b1baccb271d6c62edb16497898ea483c2d51e34 100644
--- a/clx/clx-port.lisp
+++ b/clx/clx-port.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clx-port.lisp,v 1.16 92/10/02 15:19:06 cer Exp $
+;; $fiHeader: clx-port.lisp,v 1.17 92/10/28 11:31:16 cer Exp $
 
 (in-package :clx-clim)
 
@@ -46,11 +46,11 @@
 ;;--- Eventually do better than this
 (defclass clx-palette (basic-palette) ())
 
-(defmethod make-palette ((port clx-port) &key color-p mutable-p)
+(defmethod make-palette ((port clx-port) &key color-p dynamic-p)
   (make-instance 'clx-palette
     :port port 
     :color-p color-p
-    :mutable-p mutable-p))
+    :dynamic-p dynamic-p))
 
 
 (defmethod initialize-instance :after ((port clx-port) &key server-path)
@@ -86,7 +86,7 @@
 			     :background (xlib:screen-white-pixel screen)))
 	  (setf (slot-value port 'silica::default-palette) 
 		(make-palette port :color-p color-p
-				   :mutable-p (and (member vic '(:gray-scale
+				   :dynamic-p (and (member vic '(:gray-scale
 								 :pseudo-color
 								 :direct-color))
 						   t))))
diff --git a/clx/clx-prefill.lisp b/clx/clx-prefill.lisp
index bdc4eb7e8e0dc9fce43cf817a5f8665eb996ddc7..c14f82d724ce6e4b680af8634f1edb13a1f7c5d1 100644
--- a/clx/clx-prefill.lisp
+++ b/clx/clx-prefill.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clx-prefill.lisp,v 1.5 92/09/08 15:17:17 cer Exp $
+;; $fiHeader: clx-prefill.lisp,v 1.6 92/10/28 11:31:17 cer Exp $
 
 (in-package :clim-internals)
 
@@ -207,7 +207,7 @@
   (clx-clim::initialize-clx-port
     (clx-clim::clx-port))
   (initialize-menu
-    (clx-clim::clx-port clim-stream-pane t))
+    (clx-clim::clx-port clim-stream-pane))
   (make-frame-manager
     (clx-clim::clx-port))
   (make-medium
diff --git a/demo/color-editor.lisp b/demo/color-editor.lisp
index d707f0e3012d9b5cf638f2b2b26cbed278e547f2..60c771ea9400cb0fa86161289c7e8b717393230b 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.8 92/10/28 11:32:53 cer Exp $
+;; $fiHeader: color-editor.lisp,v 1.9 92/10/29 16:55:25 cer Exp $
 
 (in-package :clim-demo)
 
@@ -83,7 +83,7 @@
     (setf dynamic-p (palette-dynamic-p (frame-palette frame))
 	  color (if dynamic-p
 		    (make-dynamic-color +black+)
-		  +black+))))
+		    +black+))))
 
 (defmethod color ((frame color-chooser))
   (with-slots (color dynamic-p) frame
diff --git a/demo/puzzle.lisp b/demo/puzzle.lisp
index 320a19b0da2d3a430331e2f106a8323ef9e6ab02..55247071e8b0052891b0f9475c0a8a1390524c44 100644
--- a/demo/puzzle.lisp
+++ b/demo/puzzle.lisp
@@ -1,25 +1,25 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: puzzle.lisp,v 1.20 92/10/28 11:33:08 cer Exp Locker: cer $
+;; $fiHeader: puzzle.lisp,v 1.21 92/10/29 16:55:36 cer Exp $
 
 (in-package :clim-demo)
 
 "Copyright (c) 1989, 1990, 1991, 1992 Symbolics, Inc.  All rights reserved."
 
 (define-application-frame puzzle ()
-			  ((puzzle :initform (make-array '(4 4))
-				   :accessor puzzle-puzzle))
+    ((puzzle :initform (make-array '(4 4))
+	     :accessor puzzle-puzzle))
   (:panes
-   (display :application
-	    :display-function 'draw-puzzle
-	    :text-style '(:fix :bold :very-large)
-	    :incremental-redisplay t
-	    :text-cursor nil
-	    :width :compute :height :compute
-	    :end-of-page-action :allow
-	    :end-of-line-action :allow))
+    (display :application
+	     :display-function 'draw-puzzle
+	     :text-style '(:fix :bold :very-large)
+	     :incremental-redisplay t
+	     :text-cursor nil
+	     :width :compute :height :compute
+	     :end-of-page-action :allow
+	     :end-of-line-action :allow))
   (:layouts
-   (:default display)))
+    (:default display)))
 
 (defmethod frame-standard-input ((puzzle puzzle))
   (get-frame-pane puzzle 'display))
@@ -70,18 +70,18 @@
   (declare (ignore max-width max-height))
   (let ((puzzle-array (puzzle-puzzle puzzle)))
     (formatting-table (stream)
-	(dotimes (row 4)
-	  (formatting-row (stream)
-	      (dotimes (column 4)
-		(let* ((value (aref puzzle-array row column))
-		       (cell-id (encode-puzzle-cell row column)))
-		  (updating-output (stream :unique-id cell-id 
-					   :cache-value value)
-		      (formatting-cell (stream :align-x :right)
-			  (unless (zerop value)
-			    (with-output-as-presentation 
-				(stream cell-id 'puzzle-cell)
-			      (format stream "~2D" value))))))))))))
+      (dotimes (row 4)
+	(formatting-row (stream)
+	  (dotimes (column 4)
+	    (let* ((value (aref puzzle-array row column))
+		   (cell-id (encode-puzzle-cell row column)))
+	      (updating-output (stream :unique-id cell-id 
+				       :cache-value value)
+		(formatting-cell (stream :align-x :right)
+		  (unless (zerop value)
+		    (with-output-as-presentation 
+			(stream cell-id 'puzzle-cell)
+		      (format stream "~2D" value))))))))))))
 
 (defun find-open-cell (puzzle)
   (dotimes (row 4)
diff --git a/genera/genera-port.lisp b/genera/genera-port.lisp
index 5996d788155bb169620646b9444147866be6a732..ef086ad2d084dca4022e9dfa4642527eefeeb007 100644
--- a/genera/genera-port.lisp
+++ b/genera/genera-port.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: genera-port.lisp,v 1.15 92/10/28 11:32:43 cer Exp Locker: cer $
+;; $fiHeader: genera-port.lisp,v 1.16 92/11/05 17:15:46 cer Exp $
 
 (in-package :genera-clim)
 
@@ -38,11 +38,11 @@
 ;;--- Eventually do better than this
 (defclass genera-palette (basic-palette) ())
 
-(defmethod make-palette ((port genera-port) &key color-p mutable-p)
+(defmethod make-palette ((port genera-port) &key color-p dynamic-p)
   (make-instance 'genera-palette
     :port port 
     :color-p color-p
-    :mutable-p mutable-p))
+    :dynamic-p dynamic-p))
 
 
 (defmethod initialize-instance :after ((port genera-port) &key server-path)
diff --git a/genera/genera-prefill.lisp b/genera/genera-prefill.lisp
index 55836cab2a8461f4cc739be0cb452a24f9ee1c91..bca5f4bba17eea92594f50cb0b4491308b3c654d 100644
--- a/genera/genera-prefill.lisp
+++ b/genera/genera-prefill.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: genera-prefill.lisp,v 1.5 92/09/08 15:18:56 cer Exp $
+;; $fiHeader: genera-prefill.lisp,v 1.6 92/10/28 11:32:44 cer Exp $
 
 (in-package :clim-internals)
 
@@ -216,7 +216,7 @@
   (genera-clim::initialize-genera-port
     (genera-clim::genera-port))
   (initialize-menu
-    (genera-clim::genera-port clim-stream-pane t))
+    (genera-clim::genera-port clim-stream-pane))
   (make-frame-manager
     (genera-clim::genera-port))
   (make-medium
diff --git a/utils/clim-streams.lisp b/utils/clim-streams.lisp
index 4a3488ca3d9d306d27af4a0d8637d75466981529..ef8703053e5ee2f6fb765caef4c0731a5f5c2b40 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.6 92/09/08 15:16:57 cer Exp $
+;; $fiHeader: clim-streams.lisp,v 1.7 92/10/02 15:18:40 cer Exp $
 
 (in-package :clim-utils)
 
@@ -21,6 +21,12 @@
 	     :reader encapsulating-stream-stream))
   #+Allegro (:default-initargs :element-type 'character))
 
+;; Return the encapsulated stream corresponding to STREAM.
+;; If you change GENERATE-STREAM-PROTOCOL-TRAMPOLINES to maintain a more complex
+;; mapping than a simple binding of *ORIGINAL-STREAM*, change this too.
+(defmacro encapsulated-stream (stream &optional (encapsulated-stream '*original-stream*))
+  `(or ,encapsulated-stream ,stream))
+
 
 ;;; Shadow this for all Lisp implementations
 
diff --git a/utils/extended-regions.lisp b/utils/extended-regions.lisp
index 0f2a77ad52528e5ebb2be8818984a09039f4b968..8e45de0ee7afe4583ecb03ffe34cf00b227672a5 100644
--- a/utils/extended-regions.lisp
+++ b/utils/extended-regions.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: extended-regions.lisp,v 1.3 92/05/07 13:11:37 cer Exp $
+;; $fiHeader: extended-regions.lisp,v 1.4 92/10/02 15:18:48 cer Exp $
 
 (in-package :clim-utils)
 
@@ -18,7 +18,7 @@
      (points :type simple-vector :initarg :points :reader polygon-points)))
 
 (define-constructor make-line-1 standard-line (start-x start-y end-x end-y points)
-		    :start-x start-x :start-y start-y :end-x end-x :end-y end-y :points points)
+  :start-x start-x :start-y start-y :end-x end-x :end-y end-y :points points)
 
 (defun make-line (start-point end-point)
   (make-line-1 (point-x start-point) (point-y start-point)
@@ -26,7 +26,7 @@
 	       (vector start-point end-point)))
 
 (define-constructor make-line*-1 standard-line (start-x start-y end-x end-y)
-		    :start-x start-x :start-y start-y :end-x end-x :end-y end-y)
+  :start-x start-x :start-y start-y :end-x end-x :end-y end-y)
 
 (defun make-line* (start-x start-y end-x end-y)
   (declare (type real start-x start-y end-x end-y))
@@ -219,10 +219,10 @@
     ((closed :initarg :closed :reader polyline-closed)))
 
 (define-constructor make-polyline standard-polyline (point-seq &key closed)
-		    :points (coerce point-seq 'vector) :closed closed)
+  :points (coerce point-seq 'vector) :closed closed)
 
 (define-constructor make-polyline* standard-polyline (coord-seq &key closed)
-		    :coords (coerce coord-seq 'vector) :closed closed)
+  :coords (coerce coord-seq 'vector) :closed closed)
 
 (defmethod make-load-form ((polyline standard-polyline))
   (with-slots (closed) polyline
@@ -243,10 +243,10 @@
 (defclass standard-polygon (polygon-mixin polygon) ())
 
 (define-constructor make-polygon standard-polygon (point-seq)
-		    :points (coerce point-seq 'vector))
+  :points (coerce point-seq 'vector))
 
 (define-constructor make-polygon* standard-polygon (coord-seq)
-		    :coords (coerce coord-seq 'vector))
+  :coords (coerce coord-seq 'vector))
 
 (defmethod make-load-form ((polygon standard-polygon))
   `(make-polygon ',(polygon-points polygon)))
@@ -296,8 +296,8 @@
 (defclass standard-elliptical-arc (ellipse-mixin elliptical-arc) ())
 
 (define-constructor make-elliptical-arc standard-elliptical-arc
-  (center-point radius-1-dx radius-1-dy radius-2-dx radius-2-dy
-		&key start-angle end-angle)
+		    (center-point radius-1-dx radius-1-dy radius-2-dx radius-2-dy
+		     &key start-angle end-angle)
   :center-point center-point :center-x (point-x center-point) :center-y (point-y center-point)
   :radius-1-dx (coordinate radius-1-dx) :radius-1-dy (coordinate radius-1-dy)
   :radius-2-dx (coordinate radius-2-dx) :radius-2-dy (coordinate radius-2-dy)
@@ -309,8 +309,8 @@
 		   (t nil)))
 
 (define-constructor make-elliptical-arc* standard-elliptical-arc
-  (center-x center-y radius-1-dx radius-1-dy radius-2-dx radius-2-dy
-	    &key start-angle end-angle)
+		    (center-x center-y radius-1-dx radius-1-dy radius-2-dx radius-2-dy
+		     &key start-angle end-angle)
   :center-x center-x :center-y center-y
   :radius-1-dx (coordinate radius-1-dx) :radius-1-dy (coordinate radius-1-dy)
   :radius-2-dx (coordinate radius-2-dx) :radius-2-dy (coordinate radius-2-dy)
@@ -352,8 +352,8 @@
 (defclass standard-ellipse (ellipse-mixin ellipse) ())
 
 (define-constructor make-ellipse standard-ellipse
-  (center-point radius-1-dx radius-1-dy radius-2-dx radius-2-dy
-		&key start-angle end-angle)
+		    (center-point radius-1-dx radius-1-dy radius-2-dx radius-2-dy
+		     &key start-angle end-angle)
   :center-point center-point :center-x (point-x center-point) :center-y (point-y center-point)
   :radius-1-dx (coordinate radius-1-dx) :radius-1-dy (coordinate radius-1-dy)
   :radius-2-dx (coordinate radius-2-dx) :radius-2-dy (coordinate radius-2-dy)
@@ -365,8 +365,8 @@
 		   (t nil)))
 
 (define-constructor make-ellipse* standard-ellipse
-  (center-x center-y radius-1-dx radius-1-dy radius-2-dx radius-2-dy
-	    &key start-angle end-angle)
+		    (center-x center-y radius-1-dx radius-1-dy radius-2-dx radius-2-dy
+		     &key start-angle end-angle)
   :center-x center-x :center-y center-y
   :radius-1-dx (coordinate radius-1-dx) :radius-1-dy (coordinate radius-1-dy)
   :radius-2-dx (coordinate radius-2-dx) :radius-2-dy (coordinate radius-2-dy)
diff --git a/utils/regions.lisp b/utils/regions.lisp
index d21f541870733688edbc02a12b36589c09964b82..1071fa3ff93089b1c2343ec99832fb40879154dd 100644
--- a/utils/regions.lisp
+++ b/utils/regions.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: regions.lisp,v 1.13 92/07/20 15:59:45 cer Exp $
+;; $fiHeader: regions.lisp,v 1.14 92/08/18 17:24:15 cer Exp $
 
 (in-package :clim-utils)
 
@@ -193,7 +193,7 @@
      (y :initarg :y :accessor point-y :type coordinate)))
 
 (define-constructor make-point-1 standard-point (x y)
-		    :x x :y y)
+  :x x :y y)
 
 (defun make-point (x y)
   (declare (type real x y))
@@ -304,7 +304,8 @@
      (max-y :initarg :max-y :reader rectangle-max-y :type coordinate)
      (points :initarg :points :type simple-vector :reader polygon-points)))
 
-(define-constructor make-rectangle-1 standard-rectangle (min-x min-y max-x max-y points)
+(define-constructor make-rectangle-1 standard-rectangle 
+		    (min-x min-y max-x max-y points)
   :min-x min-x :min-y min-y :max-x max-x :max-y max-y :points points)
 
 (defun make-rectangle (min-point max-point)
@@ -318,7 +319,8 @@
 			(vector min-point (make-point min-x max-y)
 				max-point (make-point max-x min-y))))))
 
-(define-constructor make-rectangle*-1 standard-rectangle (x1 y1 x2 y2)
+(define-constructor make-rectangle*-1 standard-rectangle
+		    (x1 y1 x2 y2)
   :min-x x1 :min-y y1 :max-x x2 :max-y y2)
 
 (defun make-rectangle* (x1 y1 x2 y2)
diff --git a/utils/transformations.lisp b/utils/transformations.lisp
index 6c5c3ca778575725d51c852e0fa597a945938484..cb19f8b91caa0b8eeea58e71f2771315a8eb7f50 100644
--- a/utils/transformations.lisp
+++ b/utils/transformations.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: transformations.lisp,v 1.8 92/07/08 16:29:37 cer Exp $
+;; $fiHeader: transformations.lisp,v 1.9 92/08/18 17:24:17 cer Exp $
 
 (in-package :clim-utils)
 
@@ -64,7 +64,7 @@
      (ty :type single-float :initarg :ty)))
 
 (define-constructor make-translation-transformation-1 translation-transformation
-  (tx ty)
+		    (tx ty)
   :tx tx :ty ty)
 
 (defmethod print-object ((transform translation-transformation) stream)
@@ -91,7 +91,7 @@
      (ty :type single-float :initarg :ty)))
 
 (define-constructor make-standard-transformation-1 standard-transformation
-  (mxx mxy myx myy tx ty)
+		    (mxx mxy myx myy tx ty)
   :mxx mxx :mxy mxy :myx myx :myy myy :tx tx :ty ty)
 
 (defmethod make-load-form ((transform standard-transformation))