From 4ddfa1acdd7af89f3cc3ed3f98d8d2381cb745cd Mon Sep 17 00:00:00 2001
From: layer <layer>
Date: Tue, 4 May 1999 01:21:12 +0000
Subject: [PATCH] 5/3/99--6.0.pre-alpha.13--join from acl50 branch--tag
 acl50_merge5

---
 ChangeLog.n                | 129 ++++++
 Makefile                   |   9 +-
 Makefile.defs              |   8 +-
 Makefile.freebsd           |   4 +-
 Makefile.linux86           |  42 --
 Makefile.rs6000            |   4 +-
 Makefile.sun4-ol           |  24 --
 Makefile.sun4-svr4-ol      |  33 --
 Makefile.wnn               |   6 +-
 RELNOTES                   |  12 +-
 aclpc/acl-class.lisp       |  66 +--
 aclpc/acl-dc.lisp          |  22 +-
 aclpc/acl-frames.lisp      | 811 +++++++++++++++++++++----------------
 aclpc/acl-medium.lisp      | 348 ++++++++++------
 aclpc/acl-mirror.lisp      |  23 +-
 aclpc/acl-port.lisp        | 242 +++++++----
 aclpc/acl-prel.lisp        | 243 ++++++-----
 aclpc/acl-widget.lisp      |  40 +-
 aclpc/pkgdcl.lisp          |   7 +-
 aclpc/winwidgh.lisp        |   6 +-
 clim/accept-values.lisp    |  71 ++--
 clim/frames.lisp           |  44 +-
 clim/interactive-defs.lisp |   5 +-
 demo/bitmap-editor.lisp    |  11 +-
 instclimol.lisp            |  33 --
 make-symbolic-links.sh     |  50 ---
 makedist.sh                |  23 --
 readme.win32               |  76 ----
 silica/graphics.lisp       |  44 +-
 sys/odrawpat.lisp          |  34 +-
 test/test-suite.lisp       |  14 +-
 tk-silica/xt-graphics.lisp |  15 +-
 tk-silica/xt-silica.lisp   |  17 +-
 utils/defun-utilities.lisp |  27 +-
 utils/designs.lisp         |  25 +-
 utils/packages.lisp        |   4 +-
 36 files changed, 1445 insertions(+), 1127 deletions(-)
 delete mode 100644 Makefile.linux86
 delete mode 100644 Makefile.sun4-ol
 delete mode 100644 Makefile.sun4-svr4-ol
 delete mode 100644 instclimol.lisp
 delete mode 100644 make-symbolic-links.sh
 delete mode 100644 makedist.sh
 delete mode 100644 readme.win32

diff --git a/ChangeLog.n b/ChangeLog.n
index 3311569f..c2aeb6cd 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -10,6 +10,13 @@ If there are user-visible changes in this commit, then list the
 <standard changelog date stamp>
 	* <changes go here...>
 
+*******************************************************************************
+2.2.2.6 -- join from acl50 branch
+
+- changes from 2.2.1.45 to 2.2.1.54
+- cvs command: cvs update -d -j acl50_merge5 -j acl50
+- next merge tag: acl50_merge6
+
 *******************************************************************************
 2.2.2.5 -- join from acl50 branch
 
@@ -58,6 +65,128 @@ next merge tag: acl50_merge2
 (this should have been version 2.2.2.0, but was 2.2.1.17 instead)
 next merge tag: acl50_merge1
 
+*******************************************************************************
+2.2.1.54
+
+1999-04-15  Kevin Layer  <layer@ultra>
+
+	* Makefile.rs6000: use ../src/bin/make_exp
+
+1999-04-13    <layer@HOBART>
+
+	* clim/frames.lisp: fix for bug7897 from Jeff
+	* Makefile.defs: SHELL = sh for Interix
+
+*******************************************************************************
+2.2.1.53
+
+1999-04-08  Kevin Layer  <layer@ultra>
+
+	* clim/frames.lisp: fix for spr19429 from Jeff
+
+*******************************************************************************
+2.2.1.52
+
+Thu Apr 08 17:35:24 1999  Charles A. Cox  <cox@FOX>
+
+	* utils/defun-utilities.lisp: add backward compatible definitions
+	of newly used ics functions.
+
+*******************************************************************************
+2.2.1.51
+  
+Thu Apr 08 11:41:57 1999  Charles A. Cox  <cox@FOX>
+
+  Overall change:  Add calls to string-convertors for ffi calls to winapi.
+  This allows clim2 to run under windows iacl, but the japanese-input-stream,
+  which is unix specific, is disabled under windows.  Thus, other than being
+  able to run in iacl under Japanese Windows, there is no new or changed
+  functionality with this commit.
+
+  Furthermore, presumably due to font deficiencies, Japanese characters do not
+  display.  Finally, presumably due to "non-standard" windows input, clim
+  windows appear unable to accept Japanese character input via the Windows
+  Japanese Input Method Editor.
+	
+  NOTE: For this commit, on Windows, it is not possible to compile
+  clim2 with iacl.  One can load, however, already built fasl files
+  (eg, climnt.fasl, etc.) into iacl.
+
+	* [many files]: use with-native-string, string-to-native, etc. for
+	foreign calls to winapi.
+
+*******************************************************************************
+2.2.1.50
+
+1999-03-31  Jeff Morrill  <jmorrill@pointnclick.com> 
+
+* aclpc/acl-frames: Fix (setf command-enabled) again
+* aclpc/acl-medium: Fixes for medium-draw-polygon*, rotated text
+* aclpc/acl-mirror: Don't error for UpdateWindow, just warn.
+* aclpc/acl-port: Rotated font support
+* aclpc/acl-prel: Try to address occasional failures of CreateDIBitmap
+* aclpc/winwidgh: add memcopy
+* silica/graphics: Fix map-endpoint-sequence to fix presentation highlighting
+* clim/frames: Fix accepting-values panes for the case of recycled frames
+* clim/accept-values: Fix updating-output breakage in avv buttons
+* test/test-suite: Add test for flipping-ink
+* demo/bitmap-editor: Clean up a bit
+
+*******************************************************************************
+2.2.1.49
+
+1999-03-30    <layer@OMEGA>
+
+	* Makefile: add windows ifdef (can't believe it wasn't there!!)
+
+*******************************************************************************
+2.2.1.48
+
+1999-03-29  Kevin Layer  <layer@ultra>
+
+    changed files:
+	* Makefile: for mklinux
+	* Makefile.freebsd: Add second PIC flag
+	* Makefile.wnn: Add crypt library for freebsd
+    deleted files:
+	* Makefile.linux86
+	* Makefile.sun4-ol
+	* Makefile.sun4-svr4-ol
+	* instclimol.lisp
+	* make-symbolic-links.sh
+	* makedist.sh
+	* readme.win32
+
+*******************************************************************************
+2.2.1.47
+
+1999-03-19    <layer@OMEGA>
+
+	* Makefile.defs: add $(exe) where appropriate (for Interix)
+
+*******************************************************************************
+2.2.1.46
+
+1999-03-16    <layer@HOBART>
+
+	* aclpc/pkgdcl.lisp: load user32.dll with :system-library t
+	arguments (in lisps that support this new keyword to load)
+
+*******************************************************************************
+2.2.1.45
+
+1999-02-24  Jeff Morrill  <jmorrill@pointnclick.com> 
+
+* aclpc/acl-frames: Fix (setf command-enabled) so it sticks, fix menu-choose
+  so it can disable menu items and so it will return three values.
+* aclpc/acl-medium: Fix medium-draw-lines* so it works
+* aclpc/acl-mirror: Try to prevent infinite recursion setting edges of
+   top-level sheet ("too deep!")
+* clim/frames: Fix (setf command-enabled) so it sticks
+* tk-silica/xt-graphics: Fix port-draw-rotated-text to rotate the correct angle
+* tk-silica/xt-silica: Don't lose character bits (control, meta)
+* utils/designs: More helpful error message for palette-full condition.
+
 *******************************************************************************
 2.2.1.44
 
diff --git a/Makefile b/Makefile
index 17c330ac..231dd30c 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-# $Header: /repo/cvs.copy/clim2/Makefile,v 1.87 1999/02/25 08:23:20 layer Exp $
+# $Header: /repo/cvs.copy/clim2/Makefile,v 1.88 1999/05/04 01:20:59 layer Exp $
 
 # If ../makefile.top doesn't exist, then you must specify HOST=xxx on the
 # `make' command line.
@@ -6,6 +6,10 @@
 include ../makefile.top
 include ../makefile.defs
 
+ifeq ($(OS_NAME),windows)
+HOST = windows
+endif
+
 ifeq ($(OS_NAME),sunos)
 ifeq ($(MACHINE),sparc)
 HOST = sun4-svr4
@@ -13,9 +17,10 @@ endif
 endif
 
 ifeq ($(OS_NAME),linux)
-HOST = linux
 ifeq ($(MACHINE),ppc)
 HOST = linuxppc
+else
+HOST = linux
 endif
 endif
 
diff --git a/Makefile.defs b/Makefile.defs
index 367ed38d..516a1503 100644
--- a/Makefile.defs
+++ b/Makefile.defs
@@ -1,4 +1,4 @@
-# $Id: Makefile.defs,v 1.48 1999/02/25 08:23:21 layer Exp $
+# $Id: Makefile.defs,v 1.49 1999/05/04 01:20:59 layer Exp $
 #
 #  Makefile.defs for CLIM 2.0
 
@@ -8,10 +8,10 @@ CLIM		= clim.dxl
 SHARED_EXT = so
 
 ifeq ($(OS_NAME),windows)
-LISP	= ../src/lisp
+LISP	= ../src/lisp$(exe)
 DCL	= dcl
 else
-LISP	= ../src/lispi
+LISP	= ../src/lispi$(exe)
 DCL	= dcli
 endif
 
@@ -23,7 +23,7 @@ CAT	= cat
 ECHO	= echo
 TAGS	= etags
 
-SHELL	= /bin/sh
+SHELL	= sh
 
 # Lisp optimization for compiling
 SPEED	= 3
diff --git a/Makefile.freebsd b/Makefile.freebsd
index 81315b2f..6c418b06 100644
--- a/Makefile.freebsd
+++ b/Makefile.freebsd
@@ -1,4 +1,4 @@
-# $Id: Makefile.freebsd,v 1.2 1999/02/25 08:23:21 layer Exp $
+# $Id: Makefile.freebsd,v 1.3 1999/05/04 01:20:59 layer Exp $
 
 include Makefile.defs
 
@@ -16,7 +16,7 @@ PRODUCT-OBJS= $(PRODUCT-GENERIC-OBJS) $(STATIC-XM-OBJS) $(SHARED-XM-OBJS)
 
 #MOTIFXTRAS=-lgen
 
-PICFLAGS = -DPIC
+PICFLAGS = -fPIC -DPIC
 SHAREFLAGS = 
 MAKE_SHARED = ld -Bshareable -Bdynamic -L/usr/X11R6/lib -L/usr/local/lib
 STD_DEFINES =
diff --git a/Makefile.linux86 b/Makefile.linux86
deleted file mode 100644
index 7655c49b..00000000
--- a/Makefile.linux86
+++ /dev/null
@@ -1,42 +0,0 @@
-# $Header: /repo/cvs.copy/clim2/Attic/Makefile.linux86,v 1.3 1997/10/20 23:10:57 layer Exp $
-#
-#  Makefile.sun4-svr4 for CLIM 2.0
-#
-
-include Makefile.defs
-
-Makefile=Makefile.linux86
-
-# for other Motif versions use
-# /net/sole/opt/ICS/Motif1.2.4/usr/include
-# /net/vapor/3rd/motif-1.2.2-sol2/ICS/Motif/usr/include
-
-XINCLUDES=-I/usr/X11R6/include
-
-TKLIB=-L/usr/X11R6/lib -lXm
-XTLIB=-lXt
-XLIB= -lXpm -lXext -lX11
-
-SET_LIBRARY_PATH= \
-  LD_LIBRARY_PATH=/usr/X11R6/lib:/lib:/usr/lib:/usr/i486-linux/lib; export LD_LIBRARY_PATH
-
-# for other Motif versions use
-# /net/sole/opt/ICS/Motif1.2.4/usr/lib:/usr/lib
-# /net/vapor/3rd/motif-1.2.2-sol2/ICS/Motif/usr/lib:/usr/lib
-
-PRODUCT-OBJS= $(PRODUCT-GENERIC-OBJS) $(STATIC-XM-OBJS) $(SHARED-XM-OBJS)
-
-# from here on this file should be the same as Makefile.sun4-svr4-ol
-
-MOTIFXTRAS=
-
-PICFLAGS = -fPIC
-SHAREFLAGS = 
-MAKE_SHARED = ld -shared
-STD_DEFINES = 
-AR = ar cq
-
-ICS-PRODUCT-OBJS = 
-ICS-PRODUCT-FASLS = 
-
-include Makefile.generic
diff --git a/Makefile.rs6000 b/Makefile.rs6000
index dd5a897f..e4a1baeb 100644
--- a/Makefile.rs6000
+++ b/Makefile.rs6000
@@ -1,4 +1,4 @@
-# $Header: /repo/cvs.copy/clim2/Makefile.rs6000,v 1.11 1999/02/25 08:23:21 layer Exp $
+# $Header: /repo/cvs.copy/clim2/Makefile.rs6000,v 1.12 1999/05/04 01:20:59 layer Exp $
 #
 #  Makefile.rs6000 for CLIM 2.0
 #
@@ -16,7 +16,7 @@ XLIB=-lX11
 XINCLUDES= -I/usr/include
 
 PRODUCT-OBJS= $(PRODUCT-GENERIC-OBJS) $(STATIC-XM-OBJS) $(SHARED-XM-OBJS)
-MAKE_SHARED = ../src/bin/make_shared.ibm
+MAKE_SHARED = ../src/bin/make_shared.ibm -make_exp ../src/bin/make_exp
 STD_DEFINES = -DSYSV -DAIXV3
 AR = ar clq
 
diff --git a/Makefile.sun4-ol b/Makefile.sun4-ol
deleted file mode 100644
index 266010b4..00000000
--- a/Makefile.sun4-ol
+++ /dev/null
@@ -1,24 +0,0 @@
-# $Header: /repo/cvs.copy/clim2/Attic/Makefile.sun4-ol,v 1.3 1997/02/05 01:42:06 tomj Exp $
-#
-#  Makefile.sun4-ol for CLIM 2.0
-#
-
-include Makefile.defs
-
-Makefile=Makefile.sun4-ol
-
-CLIM=./slim.ol
-
-SYSTEM= 	openlook-clim
-PRODUCT-FASLS= 	$(PRODUCT-GENERIC-FASLS) $(PRODUCT-OL-FASLS)
-PRODUCT-OBJS= 	$(PRODUCT-GENERIC-OBJS) $(STATIC-OL-OBJS)
-
-OPENLOOKHOME=/usr/openwin
-
-XINCLUDES=-I$(OPENLOOKHOME)/include
-
-TKLIB=$(OPENLOOKHOME)/lib/libXol.a
-XTLIB=$(OPENLOOKHOME)/lib/libXt.a
-XLIB=$(OPENLOOKHOME)/lib/libX11.a
-
-include Makefile.generic
diff --git a/Makefile.sun4-svr4-ol b/Makefile.sun4-svr4-ol
deleted file mode 100644
index 269b2238..00000000
--- a/Makefile.sun4-svr4-ol
+++ /dev/null
@@ -1,33 +0,0 @@
-# $Header: /repo/cvs.copy/clim2/Attic/Makefile.sun4-svr4-ol,v 1.4 1997/10/20 23:10:57 layer Exp $
-#
-#  Makefile.sun4-svr4-ol for CLIM 2.0
-#
-
-include Makefile.defs
-
-Makefile=Makefile.sun4-svr4-ol
-
-CLIM=./slim.ol
-
-SYSTEM=		openlook-clim
-PRODUCT-FASLS= 	$(PRODUCT-GENERIC-FASLS) $(PRODUCT-OL-FASLS)
-PRODUCT-OBJS= 	$(PRODUCT-GENERIC-OBJS) $(STATIC-OL-OBJS) $(SHARED-OL-OBJS)
-
-XINCLUDES=-I/usr/openwin/include
-
-TKLIB=-lXol
-XTLIB=-lXt
-XLIB=-lX11
-
-SET_LIBRARY_PATH= \
-  LD_LIBRARY_PATH=/usr/openwin/lib:/usr/lib; export LD_LIBRARY_PATH
-
-# from here on this file should be the same as Makefile.sun4-svr4
-
-MOTIFXTRAS=-lgen
-
-PICFLAGS = -K pic
-SHAREFLAGS = 
-MAKE_SHARED = ld -G
-
-include Makefile.generic
diff --git a/Makefile.wnn b/Makefile.wnn
index ca78c55a..68e71ece 100644
--- a/Makefile.wnn
+++ b/Makefile.wnn
@@ -1,4 +1,4 @@
-# $Header: /repo/cvs.copy/clim2/Makefile.wnn,v 1.5 1999/02/25 08:23:21 layer Exp $
+# $Header: /repo/cvs.copy/clim2/Makefile.wnn,v 1.6 1999/05/04 01:20:59 layer Exp $
 #
 #  Makefile.wnn for CLIM 2.0
 #
@@ -79,6 +79,10 @@ ifeq ($(MACHINE),ppc)
 REDHATLIBS = -lcrypt
 endif
 
+ifeq ($(OS_NAME),freebsd)
+REDHATLIBS = -lcrypt
+endif
+
 wnn.$(SHARED_EXT): $(WNN_OBJS)
 	$(MAKE_SHARED) $(SHAREFLAGS) -o wnn.$(SHARED_EXT) $(WNN_OBJS) \
 		$(REDHATLIBS)
diff --git a/RELNOTES b/RELNOTES
index 2e122c1d..33b84a96 100644
--- a/RELNOTES
+++ b/RELNOTES
@@ -13,4 +13,14 @@ developers or documentation.
 
 ************* add new entries below this line *********************************
 
-1. [bug/rfe#] ...summary...
+<<<add new entries here, include bug/rfe id for each item>>>
+
+*******************************************************************************
+*** 5.0.1.beta2 items below this line
+
+1. <norfe>    CLIM works on FreeBSD only with MetroLink Motif
+	      Complete! version 1.2.4.
+
+2. <norfe>    CLIM doesn't work very well on MkLinux/LinuxPPC because
+	      all that we have there is LessTif.
+
diff --git a/aclpc/acl-class.lisp b/aclpc/acl-class.lisp
index 679338ec..0331d2a6 100644
--- a/aclpc/acl-class.lisp
+++ b/aclpc/acl-class.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: acl-class.lisp,v 1.11 1999/02/25 08:23:24 layer Exp $
+;; $Id: acl-class.lisp,v 1.12 1999/05/04 01:21:00 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -1083,7 +1083,8 @@
   ((device-handle1 :initarg :device-handle1
 		   :initform 0)
    (device-handle2 :initarg :device-handle1
-		   :initform (win:CreateDC "DISPLAY" ct:hnull ct:hnull ct:hnull))))
+		   :initform (excl:with-native-string (d "DISPLAY")
+			       (win:CreateDC d ct:hnull ct:hnull ct:hnull)))))
 
 (defun initialize-cg ()
   (let* ((dataobj (make-array 3 :element-type '(signed-byte 32))))
@@ -1242,15 +1243,17 @@
 		     win:WS_MINIMIZEBOX
 		     win:WS_MAXIMIZEBOX))))
     (setq window
-      (win:CreateWindowEx exstyle
-			  *clim-class*
-			  *win-name*
-			  winstyle
-			  left top width height
-			  (or parent 0)
-			  menu
-			  *hinst*
-			  *win-x* )) 
+      (excl:with-native-string (*clim-class* *clim-class*)
+	(excl:with-native-string (*win-name* *win-name*)
+	  (win:CreateWindowEx exstyle
+			      *clim-class*
+			      *win-name*
+			      winstyle
+			      left top width height
+			      (or parent 0)
+			      menu
+			      *hinst*
+			      *win-x* ))))
     (when (zerop window)
       (or (check-last-error "CreateWindowEx")
 	  (error "CreateWindowEx: unknown error")))
@@ -1275,16 +1278,19 @@
          (*win-name* *win-name*))
     (when pretty
       (setq *win-name* pretty))
-    (let ((window (win:CreateWindowEx
-		   (if ovl 0 win:WS_EX_TOOLWINDOW)
-		   *clim-class*
-		   *win-name*
-		   winstyle
-		   left top width height
-		   parent
-		   0
-		   *hinst*
-		   *win-x*)))
+    (let ((window
+	   (excl:with-native-string (*clim-class* *clim-class*)
+	     (excl:with-native-string (*win-name* *win-name*)
+	       (win:CreateWindowEx
+		(if ovl 0 win:WS_EX_TOOLWINDOW)
+		*clim-class*
+		*win-name*
+		winstyle
+		left top width height
+		parent
+		0
+		*hinst*
+		*win-x*)))))
       (when (zerop window)
 	(check-last-error "CreateWindowEx"))
       window)))
@@ -1316,15 +1322,17 @@
     (when pretty
       (setq *win-name* pretty))
     (setq window
+      (excl:with-native-string (*clim-class* *clim-class*)
+	(excl:with-native-string (*win-name* *win-name*)
 	  (win:CreateWindowEx exstyle
-		*clim-class*
-		*win-name*
-		winstyle
-		left top width height
-		parent
-		menu
-		*hinst*
-		*win-x*))
+			      *clim-class*
+			      *win-name*
+			      winstyle
+			      left top width height
+			      parent
+			      menu
+			      *hinst*
+			      *win-x*))))
     (when (zerop window)
       (check-last-error "CreateWindowEx"))
     (if (or (eql scroll :both)(eql scroll :vertical))
diff --git a/aclpc/acl-dc.lisp b/aclpc/acl-dc.lisp
index b4b0e5f9..83b79e07 100644
--- a/aclpc/acl-dc.lisp
+++ b/aclpc/acl-dc.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: acl-dc.lisp,v 1.8 1999/02/25 08:23:24 layer Exp $
+;; $Id: acl-dc.lisp,v 1.9 1999/05/04 01:21:00 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -236,27 +236,28 @@
 	 (brush *null-brush*)
 	 (pen (when (= code 1) (dc-image-solid-1-pen image)))
 	 (rop2 (dc-image-rop2 image))
-	 (color (dc-image-text-color image)))
+	 (text-color (dc-image-text-color image)))
     (declare (fixnum thickness code))
     (unless pen
       (when *created-pen*
 	(push *created-pen* *extra-objects*))
       (when (and dashes (> thickness 1))
-	;; CreatePen does not support this combination.
+	;; CreatePen does not support thick dashed lines.
 	;; So render dashes with thickness=1.
+	;; (Use ExtCreatePen!)
 	(setq thickness 1))
       (when (= rop2 win:R2_XORPEN)
-	(setq color #xffffff))		; black
+	(setq text-color #xffffff))		; black
       (setq pen
 	(setq *created-pen*
 	  (createPen (if dashes win:PS_DASH win:PS_SOLID)
 		     thickness
-		     color))))
+		     text-color))))
     (selectobject dc pen)
     (if dashes
 	(win:SetBkMode dc win:TRANSPARENT)
       (win:SetBkMode dc win:OPAQUE))
-    (selectobject dc brush)
+    (when brush (selectobject dc brush))
     (when rop2 (win:SetRop2 dc rop2))
     t))
 
@@ -327,8 +328,7 @@
 	 (text-color (dc-image-text-color image))
 	 (background-color (dc-image-background-color image))
 	 (brush (dc-image-brush image))
-	 (pen (dc-image-solid-1-pen image))
-	 (rop2 (dc-image-rop2 image)))
+	 (pen (dc-image-solid-1-pen image)))
     (win:SetMapMode dc win:MM_TEXT)
     (when font (selectobject dc font))
     (cond ((not background-color)
@@ -338,10 +338,12 @@
 	  (t
 	   (win:SetBkMode dc win:OPAQUE)
 	   (win:SetBkColor dc background-color)))
-    (when text-color (win:setTextColor dc text-color))
     (when brush (win:SelectObject dc brush))
     (when pen (win:SelectObject dc pen))
-    (when rop2 (win:SetRop2 dc rop2))))
+    (when text-color (win:SetTextColor dc text-color))
+    ;; SetRop2 has no effect on text.  If you want to use
+    ;; one, you have to draw into a bitmap and biblt that.
+    t))
 
 (defgeneric dc-image-for-ink (medium ink))
 
diff --git a/aclpc/acl-frames.lisp b/aclpc/acl-frames.lisp
index 603a626d..60cf2b4a 100644
--- a/aclpc/acl-frames.lisp
+++ b/aclpc/acl-frames.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: acl-frames.lisp,v 1.9 1999/02/25 08:23:24 layer Exp $
+;; $Id: acl-frames.lisp,v 1.10 1999/05/04 01:21:00 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -171,7 +171,6 @@
 		(eq c command)))))
    *menu-id->command-table*))
 
-;; pr Aug97
 (defun map-command-menu-ids (frame func &rest args)
   (dotimes (id (fill-pointer *menu-id->command-table*))
     (let ((x (aref *menu-id->command-table* id)))
@@ -179,17 +178,81 @@
 	(let ((f (first x)))
 	  (if (eq f frame) (apply func id args)))))))
 
-;;; Disable all menu items.
-(defun clim-internals::enable-menu-items (frame enablep)
+;;; The following two methods are called as a pair (see
+;;; CLIM-INTERNALS::WITH-MENU-DISABLED).
+;;;
+;;; In DISABLE-ALL-MENU-ITEMS:
+;;;  1] Remember the previously disabled-commands;
+;;;  2] Disable all the defined commands;
+;;;  3] Return the list of the previously disabled-commands.
+;;; 
+;;; In RE-ENABLE-MENU-ITEMS:
+;;;  1] Record the currently disabled-commands;
+;;;  2] re-Disable all the commands that were previously
+;;;     disabled if and only if they are still disabled.
+;;;
+;;; This last condition worries about any commands that
+;;; have been actively enabled since the corresponding
+;;; call to DISABLE-ALL-MENU-ITEMS.
+
+(defun clim-internals::disable-all-menu-items (frame)
+  ;;; Called before a command is executed.
+  ;;;
+  ;;; Push all the commands on top of the 
+  ;;; previously-disabled commands.
+  ;;;
+  ;;; In particular note that any previously-disabled
+  ;;; command will appear in the list of disabled-commands
+  ;;; two (or possibly more) times.
+  ;;;
+  ;;; See the subequent clean-up below in 
+  ;;; clim-internals::re-enable-menu-items.
   (map-command-menu-ids
    frame
    #'(lambda (menuid)
        (let ((command-name (second (aref *menu-id->command-table* menuid))))
 	 (with-slots (clim-internals::disabled-commands) frame
-	   (if enablep
-	       (setf clim-internals::disabled-commands
-		 (delete command-name clim-internals::disabled-commands))
-	     (push command-name clim-internals::disabled-commands)))))))
+	   (push command-name clim-internals::disabled-commands)))))
+  )
+
+;;; See the comment for DISABLE-ALL-MENU-ITEMS
+(defun clim-internals::re-enable-menu-items (frame)
+  (let ((new-disabled-commands nil))
+    (with-slots (clim-internals::disabled-commands) frame
+      
+      ;;; Called after a command has finished executing.
+      ;;; (See set-up above in clim-internals::disable-all-menu-items.)
+      ;;;
+      ;;; Re-Disable a command if and only if it appears
+      ;;; in the list of disabled-commands twice.
+      ;;; 
+      ;;; 1] If a command has been actively enabled during
+      ;;;    the execution of the present-command, all 
+      ;;;    appearances in the list of disabled-commands
+      ;;;    will have been removed.
+      ;;; 2] If a command has been actively disabled during
+      ;;;    the execution of the present-command, it
+      ;;;    will appear in the list two (or more) times.
+      ;;; 3] If a command was disabled before the 
+      ;;;    presently-exectuted command began, it should
+      ;;;    appear in the list two (or more) time.
+      ;;;
+      ;;; Note that this scheme loses if the presently-executing
+      ;;; command first actively enables a command and then
+      ;;; actively disables it (i.e. at the end the command
+      ;;; will appear in the list only once, and so not be
+      ;;; disabled here).
+      ;;;
+      ;;; Note also this assume that the commands are being
+      ;;; en/dis-abled throught the standard (setf command-enabled)
+      ;;; mechanism.  I.e. the user's code hasn't been
+      ;;; directly munging the disabled-command slot.
+      (loop for (com . rest) on clim-internals::disabled-commands
+	  do (when (member com rest)
+	       (pushnew com new-disabled-commands)))
+      
+      (setq clim-internals::disabled-commands
+	new-disabled-commands))))      
 
 ;;; Either of these would be nicer, but redisplay of the menu bar causes them to not
 ;;; always get repainted in their ungrayed state at the end.  pr Aug97
@@ -369,16 +432,20 @@
 	    (when acckey
 	      (record-accelerator frame acckey value top-level-sheet))
 	    (let ((menu-item-id (assign-command-menu-item-id value frame)))
-	      (win:AppendMenu
-	       menuhand
-	       flags
-	       menu-item-id
-	       (make-menu-text menu 
-			       ;; Don't display the accelerator key if
-			       ;; the command is going to land on the menu bar itself,
-			       ;; Windows will not correctly display such text.
-			       (if top-level-p nil acckey)
-			       item))
+	      (excl:with-native-string (m (make-menu-text
+				      menu 
+				      ;; Don't display the accelerator key if
+				      ;; the command is going to land on the
+				      ;; menu bar itself,
+				      ;; Windows will not correctly display
+				      ;; such text.
+				      (if top-level-p nil acckey)
+				      item))
+		(win:AppendMenu
+		 menuhand
+		 flags
+		 menu-item-id
+		 m))
 	      (push menu-item-id (gethash menuhand *popup-menu->menu-item-ids*))))
 	   (:function
 	    (warn ":function not yet implemented in menu bars")
@@ -387,16 +454,18 @@
 	    (let* ((submenu (win:CreatePopupMenu))
 		   (submenu-handle (ct:handle-value 'win:hmenu submenu))
 		   (menutext (make-menu-text menu acckey item)))
-	      (win:AppendMenu menuhand
-			       smflags
-			       submenu-handle
-			       menutext)
+	      (excl:with-native-string (menutext menutext)
+		(win:AppendMenu menuhand
+				smflags
+				submenu-handle
+				menutext))
 	      (make-menu-for-command-table value submenu-handle frame top-level-sheet)))
 	   (:divider
-	    (win:AppendMenu menuhand
-			     win:MF_SEPARATOR
-			     0
-			     "x")
+	    (excl:with-native-string (x "x")
+	      (win:AppendMenu menuhand
+			      win:MF_SEPARATOR
+			      0
+			      x))
 	    ))))
    command-table))
 
@@ -423,7 +492,8 @@
 	 (ticknow (when tickthen (slot-value (find-command-table command-table)
 					     'clim-internals::menu-tick))))
     (when (and tickthen ticknow (not (= tickthen ticknow)))
-      (make-menu-for-command-table command-table menuhand frame t)
+      (make-menu-for-command-table command-table menuhand frame 
+				   (frame-top-level-sheet frame) t)
       t)))
 
 (defun update-menu-item-sensitivities (hmenu)
@@ -610,7 +680,9 @@ to be run from another."
         (dotimes (i subsize)
           (ct:cset (:char 256) cstr ((fixnum i)) (char-int (char name i))))
 	(ct:cset (:char 256) cstr ((fixnum subsize)) (char-int #\NULL))
-	(or (win:SetWindowText win cstr)
+	(or #+removed (win:SetWindowText win cstr)
+	    (excl:with-native-string (cstr name)
+	      (win:SetWindowText win cstr))
 	    (check-last-error "SetWindowText"))))))
 
 (defun select-messagebox-icon (style)
@@ -717,338 +789,357 @@ to be run from another."
 		 ((= code win:idignore) (or (find-label "Ignore") :exit)))))))
 
 (defun message-box (hwnd message-string name &optional icon)
-  (win:messagebox hwnd
-		  (coerce message-string 'simple-string)
-		  (coerce name 'simple-string)
-		  (or icon 
-		      (logior win:MB_ICONSTOP 
-			      win:MB_TASKMODAL))))
- 
-(defmethod frame-manager-notify-user
-    ((framem acl-frame-manager) message-string
-     &key (style :inform)
-	  (frame nil frame-p)
-	  (associated-window
-	   (if frame-p
-	       (frame-top-level-sheet frame)
-	     (graft framem)))
-	  (title "Notification") 
-	  documentation
-	  (exit-boxes '(:exit :abort))
-	  (name title)
-	  text-style
-     &allow-other-keys)
-  (declare (ignore documentation))	; FIXME
-  ;; Uses MessageBox() to put up a simple dialog box,
-  ;; unless the user has specified some fancy options, in
-  ;; which case accepting-values will have to suffice.
-  (let ((icon (select-messagebox-icon style))
-	(buttons (select-messagebox-buttons exit-boxes)))
-    (if (and icon buttons (not text-style))
-	(let* ((hwnd (sheet-mirror associated-window))
-	       (code (message-box
-		      hwnd
-		      (coerce message-string 'simple-string) 
-		      (coerce name 'simple-string)
-		      (logior win:MB_TASKMODAL icon buttons)))
-	       (symbol (select-messagebox-result code buttons exit-boxes)))
-	  ;; Notify-user is supposed to return T or NIL:
-	  (case symbol
-	    (:exit t)
-	    (:abort nil)
-	    (otherwise symbol)))
-      (let ((stream associated-window))
-	(accepting-values (stream :exit-boxes exit-boxes
-				  :scroll-bars :both
-				  :label name
-				  :own-window t)
-	  (with-text-style (stream text-style)
-	    (write-string message-string stream)))))))
-
-(defun do-one-menu-item (popmenu item printer tick alist submenus)
-  (let ((*print-circle* nil))
-    (flet ((print-item (item)
-	     (silica::xlat-newline-return 
-	      (with-output-to-string (stream)
-		;; The click-right menu uses PRESENT at this point to
-		;; get the menu text, using the stream-default-view, which needs to be
-		;; set to textual-menu-view.
-		(letf-globally (((stream-default-view stream) +textual-menu-view+))
-		  (funcall (or printer #'print-menu-item) item stream))))))
-      (declare (dynamic-extent #'print-item))
-      (incf tick)
-      (ecase (clim-internals::menu-item-type item)
-	(:divider
-	 (win:appendmenu popmenu win:MF_SEPARATOR tick 0))
-	(:label
-	 (win:appendmenu popmenu win:MF_DISABLED tick 
-			 (print-item item)))
-	(:item
-	 (if (clim-internals::menu-item-items item)
-	     (let ((submenu (win:createpopupmenu)))
-	       (push submenu submenus)
-	       ;; submenu
-	       (win:appendmenu popmenu win:MF_POPUP submenu
-			       (print-item item))
-	       (map nil
-		 #'(lambda (it)
-		     (multiple-value-setq (tick alist submenus)
-		       (do-one-menu-item submenu it printer
-					 tick alist submenus)))
-		 (clim-internals::menu-item-items item)))
-	   (progn
-	     (push (list tick (menu-item-value item))
-		   alist)
-	     (win:appendmenu popmenu win:MF_ENABLED tick 
-			     (print-item item))))))
-      (values tick alist submenus))))
-
-;; Gets rid of scroll bars if possible.
-(defmethod frame-manager-menu-choose
-    ((framem acl-frame-manager) items &rest keys
-     &key printer
-	  presentation-type
-	  (associated-window (frame-top-level-sheet *application-frame*))
-	  text-style label
-	  foreground background
-	  cache
-	  (unique-id items)
-	  (id-test 'equal)
-	  (cache-value items)
-	  (cache-test #'equal)
-	  (gesture :select)
-	  row-wise
-	  n-columns
-	  n-rows
-	  x-position
-	  y-position
-	  scroll-bars)
-  ;; The basic theory of ignoring is that we ignore arguments
-  ;; that don't contribute functionality and just bring up
-  ;; the native menu without any fluff.
-  (declare (ignore text-style cache
-		   cache-test cache-value
-		   id-test unique-id label
-		   foreground background))
-  (if (or presentation-type ;; foreground background  
-	  row-wise n-columns n-rows scroll-bars)
-      (call-next-method)
-    #+simple-but-sure
-    (apply #'call-next-method framem items :scroll-bars nil keys)
-    (let ((popmenu (win:CreatePopupMenu))
-	  (submenus nil)
-	  (flags (logior win:tpm_returncmd ; return the selection
-			 win:tpm_nonotify ; don't notify clim
-			 (if (eq gesture :menu) 
-			     win:tpm_rightbutton
-			   win:tpm_leftbutton)))
-	  (rect 0)
-	  (tick 0)
-	  (alist nil)
-	  (code 0))
-      (when (zerop popmenu)
-	(check-last-error "CreatePopupMenu"))
-      (unless (and x-position y-position)
-	;; Get screen coordinates of pointer.
-	(let ((point (ct:ccallocate win:point)))
-	  (or (win:getCursorPos point)
-	      (check-last-error "GetCursorPos"))
-	  (setq x-position (ct:cref win:point point x))
-	  (setq y-position (ct:cref win:point point y))))
-      (setq x-position (truncate x-position))
-      (setq y-position (truncate y-position))
-      (map nil #'(lambda (item)
-		   (multiple-value-setq (tick alist submenus)
-		     (do-one-menu-item popmenu item printer 
-				       tick alist submenus)))
-	   items)
-      ;; Bug here, exhibited by CAD Demo Create, that menu
-      ;; is sometimes never exposed.  TrackPopupMenu returns 0.  
-      ;; But most of the time this seems to work... 5/98 JPM.
-      (setq code
-	(win:trackpopupmenu
-	 popmenu flags x-position y-position 
-	 0				; reserved, must be zero
-	 (sheet-mirror associated-window) rect))
-      (win:destroymenu popmenu)
-      (dolist (submenu submenus) (win:destroymenu submenu))
-      (cond ((zerop code)		; no item is selected
-	     nil)
-	    (t
-	     (second (assoc code alist)))))))
-
-(defun make-filter-string (dotted-pair)
-  (let ((*print-circle* nil))
-    (format nil "~a (~a)~a~a~a"
-	    (car dotted-pair) (cdr dotted-pair) (code-char 0)
-	    (cdr dotted-pair) (code-char 0))))
-
-(eval-when (compile load eval) 
-  ;; All pathnames returned by SELECT-FILE must fit in the scratch string,
-  ;; so make it pretty big.
-  (defconstant *scratch-string-length* 2048)
-  )
-
-(defparameter *scratch-lisp-string*
-    (make-string *scratch-string-length*))
-
-(defparameter *scratch-c-string*
-  (ff:allocate-fobject-c `(:array :char ,*scratch-string-length*)))
-
-(defun lisp-string-to-scratch-c-string (lisp-string)
-  (let ((length (min (length lisp-string)
-		     (1- *scratch-string-length*))))
-    (dotimes (i length 
-	       ;; null term
-	       (setf (ff:fslot-value-c '(:array :char 1)
-					*scratch-c-string*
-					length) 0))
-      (setf (ff:fslot-value-c '(:array char 1) *scratch-c-string*
-			       i)
-	(char-int (aref lisp-string i))))
-    *scratch-c-string*
+  (excl:with-native-string (m (coerce message-string 'simple-string))
+    (excl:with-native-string (n (coerce name 'simple-string))
+       (win:messagebox hwnd
+		       m
+		       n
+		       (or icon 
+			   (logior win:MB_ICONSTOP 
+				   win:MB_TASKMODAL))))))
+
+ (defmethod frame-manager-notify-user
+     ((framem acl-frame-manager) message-string
+      &key (style :inform)
+	   (frame nil frame-p)
+	   (associated-window
+	    (if frame-p
+		(frame-top-level-sheet frame)
+	      (graft framem)))
+	   (title "Notification") 
+	   documentation
+	   (exit-boxes '(:exit :abort))
+	   (name title)
+	   text-style
+      &allow-other-keys)
+   (declare (ignore documentation))	; FIXME
+   ;; Uses MessageBox() to put up a simple dialog box,
+   ;; unless the user has specified some fancy options, in
+   ;; which case accepting-values will have to suffice.
+   (let ((icon (select-messagebox-icon style))
+	 (buttons (select-messagebox-buttons exit-boxes)))
+     (if (and icon buttons (not text-style))
+	 (let* ((hwnd (sheet-mirror associated-window))
+		(code (message-box
+		       hwnd
+		       (coerce message-string 'simple-string) 
+		       (coerce name 'simple-string)
+		       (logior win:MB_TASKMODAL icon buttons)))
+		(symbol (select-messagebox-result code buttons exit-boxes)))
+	   ;; Notify-user is supposed to return T or NIL:
+	   (case symbol
+	     (:exit t)
+	     (:abort nil)
+	     (otherwise symbol)))
+       (let ((stream associated-window))
+	 (accepting-values (stream :exit-boxes exit-boxes
+				   :scroll-bars :both
+				   :label name
+				   :own-window t)
+	   (with-text-style (stream text-style)
+	     (write-string message-string stream)))))))
+
+ (defun do-one-menu-item (popmenu item printer tick alist submenus)
+   (let ((*print-circle* nil))
+     (flet ((print-item (item)
+	      (silica::xlat-newline-return 
+	       (with-output-to-string (stream)
+		 ;; The click-right menu uses PRESENT at this point to
+		 ;; get the menu text, using the stream-default-view, which needs to be
+		 ;; set to textual-menu-view.
+		 (letf-globally (((stream-default-view stream) +textual-menu-view+))
+		   (funcall (or printer #'print-menu-item) item stream))))))
+       (declare (dynamic-extent #'print-item))
+       (incf tick)
+       (ecase (clim-internals::menu-item-type item)
+	 (:divider
+	  (win:appendmenu popmenu win:MF_SEPARATOR tick 0))
+	 (:label
+	  (excl:with-native-string (p-i (print-item item))
+	    (win:appendmenu popmenu win:MF_DISABLED tick 
+			    p-i)))
+	 (:item
+	  (if (clim-internals::menu-item-items item)
+	      (let ((submenu (win:createpopupmenu)))
+		(push submenu submenus)
+		;; submenu
+		(excl:with-native-string (p-i (print-item item))
+		  (win:appendmenu popmenu win:MF_POPUP submenu
+				  p-i))
+		(map nil
+		  #'(lambda (it)
+		      (multiple-value-setq (tick alist submenus)
+			(do-one-menu-item submenu it printer
+					  tick alist submenus)))
+		  (clim-internals::menu-item-items item)))
+	    (progn
+	      (push (list tick (menu-item-value item))
+		    alist)
+
+	      (excl:with-native-string (p-i (print-item item))
+		(if (clim-internals::menu-item-active item)
+		    (win:appendmenu popmenu win:MF_ENABLED tick 
+				    p-i)
+		;;; Use win:MF_GRAYED rather than win:MF_DISABLED.
+		;;; The latter will also disable the command, but
+		;;; doesn't seem to affect the appearance.	       
+		  (win:appendmenu popmenu win:MF_GRAYED tick 
+				  p-i)))))))
+       (values tick alist submenus))))
+
+ ;; Gets rid of scroll bars if possible.
+ (defmethod frame-manager-menu-choose
+     ((framem acl-frame-manager) items &rest keys
+      &key printer
+	   presentation-type
+	   (associated-window (frame-top-level-sheet *application-frame*))
+	   text-style label
+	   foreground background
+	   cache
+	   (unique-id items)
+	   (id-test 'equal)
+	   (cache-value items)
+	   (cache-test #'equal)
+	   (gesture :select)
+	   row-wise
+	   n-columns
+	   n-rows
+	   x-position
+	   y-position
+	   scroll-bars)
+   ;; The basic theory of ignoring is that we ignore arguments
+   ;; that don't contribute functionality and just bring up
+   ;; the native menu without any fluff.
+   (declare (ignore text-style cache
+		    cache-test cache-value
+		    id-test unique-id label
+		    foreground background))
+   (if (or presentation-type ;; foreground background  
+	   row-wise n-columns n-rows scroll-bars)
+       (call-next-method)
+     #+simple-but-sure
+     (apply #'call-next-method framem items :scroll-bars nil keys)
+     (let ((popmenu (win:CreatePopupMenu))
+	   (submenus nil)
+	   (flags (logior win:tpm_returncmd ; return the selection
+			  win:tpm_nonotify ; don't notify clim
+			  (if (eq gesture :menu) 
+			      win:tpm_rightbutton
+			    win:tpm_leftbutton)))
+	   (rect 0)
+	   (tick 0)
+	   (alist nil)
+	   (code 0))
+       (when (zerop popmenu)
+	 (check-last-error "CreatePopupMenu"))
+       (unless (and x-position y-position)
+	 ;; Get screen coordinates of pointer.
+	 (let ((point (ct:ccallocate win:point)))
+	   (or (win:getCursorPos point)
+	       (check-last-error "GetCursorPos"))
+	   (setq x-position (ct:cref win:point point x))
+	   (setq y-position (ct:cref win:point point y))))
+       (setq x-position (truncate x-position))
+       (setq y-position (truncate y-position))
+       (map nil #'(lambda (item)
+		    (multiple-value-setq (tick alist submenus)
+		      (do-one-menu-item popmenu item printer 
+					tick alist submenus)))
+	    items)
+       ;; Bug here, exhibited by CAD Demo Create, that menu
+       ;; is sometimes never exposed.  TrackPopupMenu returns 0.  
+       ;; But most of the time this seems to work... 5/98 JPM.
+       (setq code
+	 (win:trackpopupmenu
+	  popmenu flags x-position y-position 
+	  0				; reserved, must be zero
+	  (sheet-mirror associated-window) rect))
+       (win:destroymenu popmenu)
+       (dolist (submenu submenus) (win:destroymenu submenu))
+       (cond ((zerop code)		; no item is selected
+	      nil)
+	     (t
+	      (let ((x (assoc code alist)))
+		(values (second x) (third x) :unknown-gesture))
+	      )))))
+
+ (defun make-filter-string (dotted-pair)
+   (let ((*print-circle* nil))
+     (format nil "~a (~a)~a~a~a"
+	     (car dotted-pair) (cdr dotted-pair) (code-char 0)
+	     (cdr dotted-pair) (code-char 0))))
+
+ (eval-when (compile load eval) 
+   ;; All pathnames returned by SELECT-FILE must fit in the scratch string,
+   ;; so make it pretty big.
+   (defconstant *scratch-string-length* 2048)
+   )
+
+ (defparameter *scratch-lisp-string*
+     (make-string *scratch-string-length*))
+
+ (defparameter *scratch-c-string*
+   (ff:allocate-fobject-c `(:array :char ,*scratch-string-length*)))
+
+ (defun lisp-string-to-scratch-c-string (lisp-string)
+   (let ((length (min (length lisp-string)
+		      (1- *scratch-string-length*))))
+     (dotimes (i length 
+		;; null term
+		(setf (ff:fslot-value-c '(:array :char 1)
+					 *scratch-c-string*
+					 length) 0))
+       (setf (ff:fslot-value-c '(:array char 1) *scratch-c-string*
+				i)
+	 (char-int (aref lisp-string i))))
+     *scratch-c-string*
+     ))
+
+ (defun scratch-c-string-to-lisp-string ()
+   (ff:char*-to-string *scratch-c-string*))
+
+ (defun pathnames-from-directory-and-filenames (filename-list)
+   ;; Takes a list consisting of a directory namestring followed
+   ;; by a set of filenames relative to that directory.
+   ;; This is the sort of list returned by the common dialog
+   ;; when multiple choices are allowed.
+   ;; Returns a list of complete pathnames.
+   (if (eq (length filename-list) 1)
+       ;; If only one choice, no separate directory is returned
+       ;; by the GetOpenFileName call.
+       filename-list
+     (let ((directory (car filename-list)))
+       ;; Windows doesn't stick a backslash on the end of the dir.
+       (unless (eql (aref directory (1- (length directory))) #\\)
+	 (setf directory (concatenate 'string directory "\\")))
+       (mapcar #'(lambda (filename)
+		   ;; cac removed call to namestring to have this function
+		   ;; return pathnames instead of strings.
+		   ;; 5-apr-94
+		   (merge-pathnames filename directory))
+	       (cdr filename-list)))))
+
+ (defun delimited-string-to-list (string delimiter-char-or-string)
+   "Returns a list of substrings of STRING, separating it at DELIMETER-CHAR-OR-STRING"
+   (do* ((stringp (stringp delimiter-char-or-string))
+	 (delimiter-length (if stringp
+			       (length delimiter-char-or-string)
+			     1))
+	 (s string (subseq s (+ index delimiter-length)))
+	 (index
+	  (if stringp
+	      (search delimiter-char-or-string s)
+	    (position delimiter-char-or-string s))
+	  (if stringp
+	      (search delimiter-char-or-string s)
+	    (position delimiter-char-or-string s)))
+	 (list
+	  (list (subseq s 0 index))
+	  (nconc list (list (subseq s 0 index)))))
+       ((null index)
+	list)))
+
+ (defun spaced-string-to-list (string) ;; <27>
+   (delimited-string-to-list string #\space))
+
+ (cl:defparameter common-dialog-errors
+  '((#xffff . cderr_dialogfailure)
+    (#x0000 . cderr_generalcodes)
+    (#x0001 . cderr_structsize)
+    (#x0002 . cderr_initialization)
+    (#x0003 . cderr_notemplate)
+    (#x0004 . cderr_nohinstance)
+    (#x0005 . cderr_loadstrfailure)
+    (#x0006 . cderr_findresfailure)
+    (#x0007 . cderr_loadresfailure)
+    (#x0008 . cderr_lockresfailure)
+    (#x0009 . cderr_memallocfailure)
+    (#x000a . cderr_memlockfailure)
+    (#x000b . cderr_nohook)
+    (#x000c . cderr_registermsgfail)
+    (#x1000 . pderr_printercodes)
+    (#x1001 . pderr_setupfailure)
+    (#x1002 . pderr_parsefailure)
+    (#x1003 . pderr_retdeffailure)
+    (#x1004 . pderr_loaddrvfailure)
+    (#x1005 . pderr_getdevmodefail)
+    (#x1006 . pderr_initfailure)
+    (#x1007 . pderr_nodevices)
+    (#x1008 . pderr_nodefaultprn)
+    (#x1009 . pderr_dndmmismatch)
+    (#x100a . pderr_createicfailure)
+    (#x100b . pderr_printernotfound)
+    (#x100c . pderr_defaultdifferent)
+    (#x2000 . cferr_choosefontcodes)
+    (#x2001 . cferr_nofonts)
+    (#x2002 . cferr_maxlessthanmin)
+    (#x3000 . fnerr_filenamecodes)
+    (#x3001 . fnerr_subclassfailure)
+    (#x3002 . fnerr_invalidfilename)
+    (#x3003 . fnerr_buffertoosmall)
+    (#x4000 . frerr_findreplacecodes)
+    (#x4001 . frerr_bufferlengthzero)
+    (#x5000 . ccerr_choosecolorcodes)
     ))
 
-(defun scratch-c-string-to-lisp-string ()
-  (ff:char*-to-string *scratch-c-string*))
-
-(defun pathnames-from-directory-and-filenames (filename-list)
-  ;; Takes a list consisting of a directory namestring followed
-  ;; by a set of filenames relative to that directory.
-  ;; This is the sort of list returned by the common dialog
-  ;; when multiple choices are allowed.
-  ;; Returns a list of complete pathnames.
-  (if (eq (length filename-list) 1)
-      ;; If only one choice, no separate directory is returned
-      ;; by the GetOpenFileName call.
-      filename-list
-    (let ((directory (car filename-list)))
-      ;; Windows doesn't stick a backslash on the end of the dir.
-      (unless (eql (aref directory (1- (length directory))) #\\)
-	(setf directory (concatenate 'string directory "\\")))
-      (mapcar #'(lambda (filename)
-		  ;; cac removed call to namestring to have this function
-		  ;; return pathnames instead of strings.
-		  ;; 5-apr-94
-		  (merge-pathnames filename directory))
-	      (cdr filename-list)))))
-
-(defun delimited-string-to-list (string delimiter-char-or-string)
-  "Returns a list of substrings of STRING, separating it at DELIMETER-CHAR-OR-STRING"
-  (do* ((stringp (stringp delimiter-char-or-string))
-	(delimiter-length (if stringp
-                              (length delimiter-char-or-string)
-			    1))
-	(s string (subseq s (+ index delimiter-length)))
-	(index
-	 (if stringp
-	     (search delimiter-char-or-string s)
-	   (position delimiter-char-or-string s))
-	 (if stringp
-	     (search delimiter-char-or-string s)
-	   (position delimiter-char-or-string s)))
-	(list
-	 (list (subseq s 0 index))
-	 (nconc list (list (subseq s 0 index)))))
-      ((null index)
-       list)))
-
-(defun spaced-string-to-list (string) ;; <27>
-  (delimited-string-to-list string #\space))
-
-(cl:defparameter common-dialog-errors
- '((#xffff . cderr_dialogfailure)
-   (#x0000 . cderr_generalcodes)
-   (#x0001 . cderr_structsize)
-   (#x0002 . cderr_initialization)
-   (#x0003 . cderr_notemplate)
-   (#x0004 . cderr_nohinstance)
-   (#x0005 . cderr_loadstrfailure)
-   (#x0006 . cderr_findresfailure)
-   (#x0007 . cderr_loadresfailure)
-   (#x0008 . cderr_lockresfailure)
-   (#x0009 . cderr_memallocfailure)
-   (#x000a . cderr_memlockfailure)
-   (#x000b . cderr_nohook)
-   (#x000c . cderr_registermsgfail)
-   (#x1000 . pderr_printercodes)
-   (#x1001 . pderr_setupfailure)
-   (#x1002 . pderr_parsefailure)
-   (#x1003 . pderr_retdeffailure)
-   (#x1004 . pderr_loaddrvfailure)
-   (#x1005 . pderr_getdevmodefail)
-   (#x1006 . pderr_initfailure)
-   (#x1007 . pderr_nodevices)
-   (#x1008 . pderr_nodefaultprn)
-   (#x1009 . pderr_dndmmismatch)
-   (#x100a . pderr_createicfailure)
-   (#x100b . pderr_printernotfound)
-   (#x100c . pderr_defaultdifferent)
-   (#x2000 . cferr_choosefontcodes)
-   (#x2001 . cferr_nofonts)
-   (#x2002 . cferr_maxlessthanmin)
-   (#x3000 . fnerr_filenamecodes)
-   (#x3001 . fnerr_subclassfailure)
-   (#x3002 . fnerr_invalidfilename)
-   (#x3003 . fnerr_buffertoosmall)
-   (#x4000 . frerr_findreplacecodes)
-   (#x4001 . frerr_bufferlengthzero)
-   (#x5000 . ccerr_choosecolorcodes)
-   ))
-
-(defun get-pathname-flags (save-p multiple-p warn-if-exists-p)
-  (logior
-   (if multiple-p win:OFN_ALLOWMULTISELECT 0)
-   (if save-p 0 win:OFN_FILEMUSTEXIST)
-   ;; This is only relevant if save-p:
-   (if warn-if-exists-p win:OFN_OVERWRITEPROMPT 0)
-   win:OFN_NOCHANGEDIR
-   win:OFN_HIDEREADONLY))
-
-(defun get-pathname (prompt directory stream allowed-types initial-name
-		     save-p multiple-p warn-if-exists-p)
-  (flet ((fill-c-string (string)
-	   (let ((c-string (ff:allocate-fobject-c '(:array :char 256)))
-		 (length (length string)))
-	     (assert (< length 255))
-	     (dotimes (i length)
-	       (setf (ff:fslot-value-c '(:array char 1) c-string i)
-		 (char-int (aref string i))))
-	     (setf (ff:fslot-value-c '(:array :char 1) c-string length)
-	       0)
-	     c-string)))
-    (let* ((open-file-struct (ct:ccallocate win:openfilename))
-	   (file-filter-string 
-	    (fill-c-string
-	     (apply #'concatenate 'string
-		    (mapcar #'make-filter-string allowed-types))))
-	   (initial-dir-string (fill-c-string (string directory)))
-	   (prompt-string (fill-c-string (string prompt))))
-      (ct:csets win:openfilename open-file-struct
-		lstructsize (ct:sizeof win:openfilename)
-		hwndowner (or (and stream (sheet-mirror stream))
-			      0)
-		hinstance 0		; no custom dialog
-		lpstrfilter file-filter-string
-		lpstrcustomfilter 0 
-		nmaxcustfilter 0 ;; length of custom filter string
-		nfilterindex 0		; zero means use custom-filter if supplied
-					; otherwise the first filter in the list
-		lpstrfile (lisp-string-to-scratch-c-string (or initial-name ""))
-		nmaxfile *scratch-string-length*
-		lpstrfiletitle 0 
-		nmaxfiletitle 0
-		lpstrinitialdir initial-dir-string
-		lpstrtitle prompt-string
-		flags (get-pathname-flags save-p multiple-p warn-if-exists-p)
-		nfileoffset 0
-		nfileextension 0 
-		lpstrdefext 0
-		lcustdata 0
-		lpfnhook 0
-		lptemplatename 0
-		)
-      (let* ((result 
+ (defun get-pathname-flags (save-p multiple-p warn-if-exists-p)
+   (logior
+    (if multiple-p win:OFN_ALLOWMULTISELECT 0)
+    (if save-p 0 win:OFN_FILEMUSTEXIST)
+    ;; This is only relevant if save-p:
+    (if warn-if-exists-p win:OFN_OVERWRITEPROMPT 0)
+    win:OFN_NOCHANGEDIR
+    win:OFN_HIDEREADONLY))
+
+ (defun get-pathname (prompt directory stream allowed-types initial-name
+		      save-p multiple-p warn-if-exists-p)
+   (flet ((fill-c-string (string)
+	    (let ((c-string (ff:allocate-fobject-c '(:array :char 256)))
+		  (length (length string)))
+	      (assert (< length 255))
+	      (dotimes (i length)
+		(setf (ff:fslot-value-c '(:array char 1) c-string i)
+		  (char-int (aref string i))))
+	      (setf (ff:fslot-value-c '(:array :char 1) c-string length)
+		0)
+	      c-string)))
+     (let* ((open-file-struct (ct:ccallocate win:openfilename))
+	    (file-filter-string 
+	     (fill-c-string
+	      (apply #'concatenate 'string
+		     (mapcar #'make-filter-string allowed-types))))
+	    (initial-dir-string (fill-c-string (string directory)))
+	    (prompt-string (fill-c-string (string prompt))))
+       (excl:with-native-string (file-filter-string file-filter-string)
+	 (excl:with-native-string (s1 (lisp-string-to-scratch-c-string (or initial-name "")))
+	   (excl:with-native-string (initial-dir-string initial-dir-string)
+	     (excl:with-native-string (prompt-string prompt-string)
+
+	       (ct:csets win:openfilename open-file-struct
+			 lstructsize (ct:sizeof win:openfilename)
+			 hwndowner (or (and stream (sheet-mirror stream))
+				       0)
+			 hinstance 0	; no custom dialog
+			 lpstrfilter file-filter-string
+			 lpstrcustomfilter 0 
+			 nmaxcustfilter 0 ;; length of custom filter string
+			 nfilterindex 0	; zero means use custom-filter if supplied
+					 ; otherwise the first filter in the list
+			 lpstrfile s1
+			 nmaxfile *scratch-string-length*
+			 lpstrfiletitle 0 
+			 nmaxfiletitle 0
+			 lpstrinitialdir initial-dir-string
+			 lpstrtitle prompt-string
+			 flags (get-pathname-flags save-p multiple-p warn-if-exists-p)
+			 nfileoffset 0
+			 nfileextension 0 
+			 lpstrdefext 0
+			 lcustdata 0
+			 lpfnhook 0
+			 lptemplatename 0
+			 )))))
+             (let* ((result 
 	      (if save-p
 		  (win:GetSaveFileName open-file-struct)
 		(win:GetOpenFileName open-file-struct))))
@@ -1450,12 +1541,14 @@ in a second Lisp process.  This frame cannot be reused."
 	;; ----
 	;; Actually, the code below repaints the entire frame. 
 	;; Shouldn't we free wrect? JPM.
+	;; ---
+	;; Don't signal errors for UpdateWindow, just warn. JPM 3/19/99.
 	(or (win:getClientRect handle wrect)
 	    (acl-clim::check-last-error "GetClientRect"))
 	(or (win:InvalidateRect handle wrect 1)
 	    (acl-clim::check-last-error "InvalidateRect"))
 	(or (win:UpdateWindow handle)
-	    (acl-clim::check-last-error "UpdateWindow"))))))
+	    (acl-clim::check-last-error "UpdateWindow" :action :warn))))))
 
 ;; Obsolete I think.
 (defun clean-frame (frame)
diff --git a/aclpc/acl-medium.lisp b/aclpc/acl-medium.lisp
index 51a88120..2d31eef5 100644
--- a/aclpc/acl-medium.lisp
+++ b/aclpc/acl-medium.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: acl-medium.lisp,v 1.10 1999/02/25 08:23:24 layer Exp $
+;; $Id: acl-medium.lisp,v 1.11 1999/05/04 01:21:00 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -90,9 +90,6 @@
     (setf window nil))
   nil)
 
-;; changed the select-acl-dc method to specialize on acl-medium rather
-;; than acl-window-medium (sdj 9/27/96)
-
 (defmethod select-acl-dc ((medium acl-medium) window dc)
   (declare (ignore window))
   (let* ((sheet (medium-sheet medium))
@@ -186,13 +183,13 @@
 	(setf (gethash ink cache)
 	  (let ((color (color->wincolor ink medium)))
 	    (declare (fixnum color))
-	    (let ((pen (win:createPen win:ps_solid 1 color))
-		  (brush (win:createSolidBrush color)))
+	    (let ((pen (win:CreatePen win:ps_solid 1 color))
+		  (brush (win:CreateSolidBrush color)))
 	      (make-dc-image :solid-1-pen pen
 			     :brush brush
 			     :text-color color 
 			     :background-color nil
-			     :rop2 win:r2_copypen
+			     :rop2 win:R2_COPYPEN
 			     )))))))
 
 ;;; ink for opacities, regions, etc
@@ -239,20 +236,21 @@
 	 (bcolor (color->wincolor bink medium))
 	 (width (array-dimension array 1))
 	 (height (array-dimension array 0))
-	 (into (make-pixel-map width height 256)))
+	 (bits-per-pixel 8)
+	 (into (make-pixel-map width height (expt 2 bits-per-pixel))))
     (dotimes (i height)
       (dotimes (j width)
 	(setf (aref into i j) (aref array i j))))
     (setf *bitmap-array* into)
-    (with-medium-dc (medium dc)
-      (let* ((bitmapinfo (get-bitmapinfo medium dc-image into designs))
-	     (bitmap (get-texture dc into bitmapinfo)))	
-	;; To Do: replace BITMAP with INTO and just use 
-	;; device-independent bitmap operations.
-	(setf (dc-image-bitmap dc-image) bitmap
-	      *created-bitmap* bitmap)
-	(setf (dc-image-background-color dc-image) bcolor)
-	(setf (dc-image-text-color dc-image) tcolor)))
+    (let* ((bitmapinfo (get-bitmapinfo medium dc-image into designs))
+	   (dc (win:GetDC 0))
+	   (bitmap (get-texture dc into bitmapinfo)))	
+      ;; To Do: replace BITMAP with INTO and just use 
+      ;; device-independent bitmap operations.
+      (setf (dc-image-bitmap dc-image) bitmap
+	    *created-bitmap* bitmap)
+      (setf (dc-image-background-color dc-image) bcolor)
+      (setf (dc-image-text-color dc-image) tcolor))
     dc-image))
 
 (defun dc-image-for-transparent-pattern (medium ink array designs)
@@ -265,7 +263,8 @@
 	 (bcolor (color->wincolor bink medium))
 	 (width (array-dimension array 1))
 	 (height (array-dimension array 0))
-	 (into (make-pixel-map width height 256)))
+	 (bits-per-pixel 8)
+	 (into (make-pixel-map width height (expt 2 bits-per-pixel))))
     (when (eq tink +transparent-ink+)
       (rotatef tink bink)
       (rotatef tcolor bcolor))
@@ -273,23 +272,23 @@
       (dotimes (j width)
 	(setf (aref into i j) (aref array i j))))
     (setf *bitmap-array* into)
-    (with-medium-dc (medium dc)
-      (let* ((bitmapinfo (get-bitmapinfo medium dc-image into designs))
-	     (bitmap (get-texture dc into bitmapinfo)))	
-	;; To Do: replace BITMAP with INTO and just use 
-	;; device-independent bitmap operations.
-	(setf (dc-image-bitmap dc-image) bitmap
-	      *created-bitmap* bitmap)
-	(setf (dc-image-background-color dc-image) bcolor)
-	(setf (dc-image-text-color dc-image) tcolor)))
+    (let* ((bitmapinfo (get-bitmapinfo medium dc-image into designs))
+	   (dc (win:GetDC 0))
+	   (bitmap (get-texture dc into bitmapinfo)))	
+      ;; To Do: replace BITMAP with INTO and just use 
+      ;; device-independent bitmap operations.
+      (setf (dc-image-bitmap dc-image) bitmap
+	    *created-bitmap* bitmap)
+      (setf (dc-image-background-color dc-image) bcolor)
+      (setf (dc-image-text-color dc-image) tcolor))
     dc-image))
 
 (defun byte-align-pixmap (a)
-  ;; Pad the pixmap so that the y dimension is a multiple of 8.
+  ;; Pad the pixmap so that the y dimension is a multiple of 4.
   ;; This copies the array, so you oughta cache the result.
   (let* ((x-dim (array-dimension a 0))
          (y-dim (array-dimension a 1))
-         (new-y-dim (* 8 (floor (/ (+ y-dim 7) 8))))
+         (new-y-dim (* 4 (ceiling y-dim 4)))
          (b nil))
     (cond ((= y-dim new-y-dim) a)	; already aligned
 	  (t
@@ -300,25 +299,11 @@
 		 (if (>= y y-dim) 0 (aref a x y)))))
 	   b))))
 
-(defun byte-align-bits (a)
-  ;; Pad the pixmap so that the y dimension is a multiple of 8.
-  ;; This copies the array, so you oughta cache the result.
-  (let* ((x-dim (array-dimension a 0))
-         (y-dim (array-dimension a 1))
-         (new-y-dim (* 8 (floor (/ (+ y-dim 7) 8))))
-         (b (make-array (list x-dim new-y-dim) 
-			:element-type 'bit
-			:initial-element 0)))
-    (dotimes (col new-y-dim)
-      (dotimes (row x-dim)
-	(setf (aref b row col)
-	  (if (>= col y-dim) 0 (if (zerop (aref a row col)) 0 1)))))
-    b))
-
 (defun pattern-to-hatchbrush (pattern)
   (multiple-value-bind (array designs) (decode-pattern pattern)
-    (let* ((tcolor (position-if #'(lambda (ink) (not (eq ink +transparent-ink+)))
-				designs))
+    (let* ((tcolor (position-if 
+		    #'(lambda (ink) (not (eq ink +transparent-ink+)))
+		    designs))
 	   (style nil))
       (unless tcolor (return-from pattern-to-hatchbrush nil))
       (when (and (> (array-dimension array 0) 1)
@@ -421,15 +406,12 @@ draw icons and mouse cursors on the screen.
 			   (null (dc-image-bitmap image1))
 			   (null (dc-image-bitmap image2)))
 		(nyi))
-	      (let ((pen (win:createPen win:ps_solid 1 color))
-		    (brush (win:createSolidBrush color)))
+	      (let ((pen (win:CreatePen win:PS_SOLID 1 color))
+		    (brush (win:CreateSolidBrush color)))
 		(make-dc-image :solid-1-pen pen
 			       :brush brush
-			       :rop2 win:r2_xorpen
-			       ;; I don't know why but text drawn
-			       ;; in this ink is invisible if you
-			       ;; use COLOR as the text color.  JPM 7/98.
-			       :text-color 0 ;color 
+			       :rop2 win:R2_XORPEN
+			       :text-color color 
 			       :background-color nil))))))))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink contrasting-ink))
@@ -498,6 +480,14 @@ draw icons and mouse cursors on the screen.
 	  (selectobject dc old))))))
 
 (defmethod medium-draw-lines* ((medium acl-medium) position-seq)
+  #+slow-but-sure
+  (let (oldx oldy)
+    (silica:map-position-sequence
+     #'(lambda (x y)
+	 (when oldx
+	   (clim:medium-draw-line* medium oldx oldy x y))
+	 (setq oldx x oldy y))
+     position-seq))
   (let ((window (medium-drawable medium))
 	(old nil))
     (with-medium-dc (medium dc)
@@ -508,18 +498,16 @@ draw icons and mouse cursors on the screen.
 	       (ink (medium-ink medium))
 	       (line-style (medium-line-style medium)))
           (set-dc-for-ink dc medium ink line-style)
-	  (do ((i 0 (+ i 4))
-               (j 1 (+ j 4))
-	       (k 2 (+ k 4))
-	       (l 3 (+ l 4)))
-            ((>= i (length position-seq)))
-            (let ((x1 (elt position-seq i))
-	          (y1 (elt position-seq j))
-		  (x2 (elt position-seq k))
-	          (y2 (elt position-seq l)))
-	      (convert-to-device-coordinates transform x1 y1 x2 y2)
-              (win:moveToEx dc x1 y1 null)
-              (win:lineTo dc x2 y2)))
+	  (let ((init t))
+	    (silica:map-position-sequence
+	     #'(lambda (x y)
+		 (convert-to-device-coordinates transform x y)
+		 (cond (init
+			(win:moveToEx dc x y null)
+			(setq init nil))
+		       (t
+			(win:lineTo dc x y))))
+	     position-seq))
 	  (selectobject dc old))))))
 
 (defmethod medium-draw-rectangle* ((medium acl-medium)
@@ -595,7 +583,9 @@ draw icons and mouse cursors on the screen.
 (defmethod medium-draw-polygon* ((medium acl-medium)
 				 position-seq closed filled)
   (let ((window (medium-drawable medium))
+	(length (length position-seq))
 	(old nil))
+    (assert (evenp length))
     (with-medium-dc (medium dc)
       (setq old (select-acl-dc medium window dc))
       (when old
@@ -605,34 +595,41 @@ draw icons and mouse cursors on the screen.
 	       (line-style (and (not filled) (medium-line-style medium)))
 	       (length (length position-seq))
 	       (numpoints (floor length 2))
-	       (extra (and closed line-style))
-	       (point-vector (ct:callocate (:long *) :size 512))) ;  limit?
-	  ;; These really are fixnums, since we're fixing coordinates below
-	  ;; (declare (type fixnum minx miny))
-	  (with-stack-array (points (if extra (+ length 2) length))
-	    (declare (type simple-vector points))
-	    (replace points position-seq) ;set up the initial contents
-	    (do ((i 0 (+ i 2))
-		 (j 0 (+ j 1)))
-		((>= i length))
-	      (let ((x (svref points i))
-		    (y (svref points (1+ i))))
-		(convert-to-device-coordinates transform x y)
-		(ct:cset (:long 512) point-vector ((fixnum (* j 2))) x)
-		(ct:cset (:long 512) point-vector ((fixnum (+ 1 (* j 2)))) y)
-		(when (and (= j 0) extra)
-		  (ct:cset (:long 512) point-vector ((fixnum (* numpoints 2))) x)
-		  (ct:cset (:long 512) point-vector ((fixnum (+ 1 (* numpoints 2)))) y)
-		  ))))
+	       (point-vector nil)
+	       (i 0))
+	  (when (and closed (not filled))
+	    (incf length 2)
+	    (incf numpoints))
+	  (setq point-vector (ff:allocate-fobject `(:array :long ,length)))
+	  (silica:map-position-sequence
+	   #'(lambda (x y)
+	       (convert-to-device-coordinates transform x y)
+	       (setf (ff:fslot-value-typed '(:array :long 1) :foreign
+					   point-vector i) 
+		 (truncate x))
+	       (incf i)
+	       (setf (ff:fslot-value-typed '(:array :long 1) :foreign
+					   point-vector i)
+		 (truncate y))
+	       (incf i))
+	   position-seq)
+	  (when (and closed (not filled))
+	    (setf (ff:fslot-value-typed '(:array :long 1) :foreign
+					point-vector i)
+	      (ff:fslot-value-typed '(:array :long 1) :foreign
+				    point-vector 0))
+	    (incf i)
+	    (setf (ff:fslot-value-typed '(:array :long 1) :foreign
+					point-vector i)
+	      (ff:fslot-value-typed '(:array :long 1) :foreign
+				    point-vector 1))
+	    (incf i))
 	  (set-dc-for-ink dc medium ink line-style)
-	  (if (null line-style)
+	  (if filled
 	      (win:polygon dc point-vector numpoints)
-	    (win:polyline dc
-			  point-vector
-			  (if (and closed line-style)
-			      (+ numpoints 1)
-			    numpoints)))
-	  (selectobject dc old))))))
+	    (win:polyline dc point-vector numpoints))
+	  (selectobject dc old)
+	  t)))))
 
 (defconstant *ft* 0.0001)
 (defun-inline fl-= (x y) (< (abs (- x y)) *ft*))
@@ -708,44 +705,137 @@ draw icons and mouse cursors on the screen.
   ;; This is not supposed to try to draw multiline text.
   ;; For that, use WRITE-STRING.
   (declare (ignore transform-glyphs))
-  (let ((window (medium-drawable medium))
-	(old nil))
+  (unless end (setq end (length string)))
+  (let* ((transform (sheet-device-transformation (medium-sheet medium))))
+    (convert-to-device-coordinates transform x y)
+    (when towards-x
+      (convert-to-device-coordinates transform towards-x towards-y)))
+  (let* ((port (port medium))
+	 (text-style (medium-merged-text-style medium))
+	 (font (text-style-mapping port text-style))
+	 (window (medium-drawable medium))
+	 (ink (medium-ink medium))
+	 (old nil)
+	 (font-angle (pos-to-font-angle x y towards-x towards-y))
+	 (x-adjust 
+	  (compute-text-x-adjustment align-x medium 
+				     string text-style start end))
+	 (y-adjust
+	  (compute-text-y-adjustment align-y (acl-font-descent font) 
+				     (acl-font-ascent font) (acl-font-height font))))
+    (incf x x-adjust)
+    (incf y y-adjust)
+    (when towards-x
+      (incf towards-x x-adjust)
+      (incf towards-y y-adjust))
+    (cond ((zerop font-angle) 
+	   (decf y (acl-font-ascent font))) ;text is positioned by its top left 
+	  (t
+	   (setq font
+	     (port-find-rotated-font port font font-angle))))
+    (if (typep ink 'clim-utils:flipping-ink)
+	(medium-draw-inverted-string* medium string x y start end font text-style)
+      (with-medium-dc (medium dc)
+	(setq old (select-acl-dc medium window dc))
+	(when old
+	  (with-temporary-substring (substring string start end)
+	    (set-dc-for-text dc medium ink (acl-font-index font))
+	    (multiple-value-bind (cstr len)
+		(silica::xlat-newline-return substring)
+	      (or
+	       (excl:with-native-string (cstr cstr)
+		 (win:TextOut dc x y cstr len))
+	       (check-last-error "TextOut" :action :warn))))
+	  (selectobject dc old))))))
+
+(defmethod medium-draw-inverted-string* ((medium acl-medium)
+					 string x y start end font text-style)
+  ;; This function should be used when the ink is flipping-ink.
+  ;; Strings cannot be drawn by calling (SetROP2 dc R2_XORPEN).
+  ;; This has no effect on TextOut.  To get the same effect,
+  ;; draw the string into a bitmap and draw the bitmap onto the screen.
+  (let (old
+	(window (medium-drawable medium))
+	(width 100)
+	(height 100))
+    (multiple-value-setq (width height) 
+      (text-size medium string :text-style text-style
+		 :start start :end end))
     (with-medium-dc (medium dc)
       (setq old (select-acl-dc medium window dc))
       (when old
-	(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 (acl-font-height font))
-		   (descent (acl-font-descent font))
-		   (ascent (acl-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 
-	      (set-dc-for-text dc medium ink (acl-font-index font))
-	      (multiple-value-bind (cstr len)
-		  (silica::xlat-newline-return substring)
-		(or (win:textOut dc x y cstr len)
-		    (check-last-error "TextOut" :action :warn))
-		)))
-	  (selectobject dc old))))))
+	(with-temporary-substring (substring string start end)
+	  (let* ((cdc (win:CreateCompatibleDC dc))
+		 (hbm (win:CreateCompatibleBitmap cdc width height))
+		 (oldbm nil))
+	    (setq oldbm (win:SelectObject cdc hbm))
+	    ;; Set the bitmap to black, then draw the text in white.
+	    (set-dc-for-text cdc medium +black+ (acl-font-index font))
+	    (win:rectangle cdc 0 0 width height)
+	    (win:SetTextColor dc 0)	; white
+	    (set-dc-for-text cdc medium +white+ (acl-font-index font))
+	    (multiple-value-bind (cstr len)
+		(silica::xlat-newline-return substring)
+	      (or
+	       (excl:with-native-string (cstr cstr)
+		 (win:TextOut cdc 0 0 cstr len))
+	       (check-last-error "TextOut" :action :warn))
+	      )
+	    ;; Copy bitmap from memory dc to screen dc
+	    (win:BitBlt dc x y width height
+			cdc 0 0 win:SRCINVERT)
+	    ;; Restore the old bitmap
+	    (win:SelectObject cdc oldbm)
+	    ;; Delete the bitmap
+	    (win:DeleteObject hbm)
+	    ;; Delete memory dc
+	    (win:DeleteDC cdc)))
+	(selectobject dc old)))
+    nil))
+
+;;; Enhance the bounding-box calculation for rotated text.
+(defmethod clim-internals::medium-text-bounding-box :around
+	   ((medium acl-window-medium) string x y
+	    start end align-x align-y text-style
+	    towards-x towards-y transform-glyphs transformation)
+  align-x align-y transform-glyphs transformation
+  (let ((font-angle nil))
+    (cond ((and (or towards-x towards-y)
+		(not (= (setq font-angle
+			  (pos-to-font-angle x y 
+					     (or towards-x x)
+					     (or towards-y y)))
+			0)))
+	   ;;; This is sort of expecnsive, but it
+	   ;;; should only happen when the text is 
+	   ;;; drawn the first time.
+	   (setq towards-x (or towards-x x))
+	   (setq towards-y (or towards-y y))
+	   ;;; Recall, font-angle is in 1/10 dgs.
+	   (let* ((font-angle-rad (* font-angle #.(/ pi (* -180 10))))
+		  (width (stream-string-width (medium-sheet medium) string
+					      :start start :end end
+					      :text-style text-style))
+		  (ascent (text-style-ascent text-style medium))
+		  (descent (text-style-descent text-style medium))
+		  (height (+ ascent descent))
+		  (transf (make-rotation-transformation* font-angle-rad x y)))
+	     (multiple-value-bind (xtr ytr)	;;; top-right corner
+		 (transform-position transf (+ x width) y)
+	       (multiple-value-bind (xbr ybr) ;;; bottom-right corner	     
+		   (transform-position transf (+ x width) (+ y height))
+		 (multiple-value-bind (xbl ybl)	;;; bottom-left corner	     
+		     (transform-position transf x (+ y height))
+		   (values (coordinate (min x xtr xbr xbl))
+			   (coordinate (min y ytr ybr ybl))
+			   (coordinate (max x xtr xbr xbl))
+			   (coordinate (max y ytr ybr ybl))
+			   ;;; None of the following seems to be
+			   ;;; used, but...
+			   (coordinate x) (coordinate y)
+			   towards-x towards-y))))))
+	  (t 
+	   (call-next-method)))))
 
 (defmethod medium-draw-character* ((medium acl-medium)
 				   char x y align-x align-y
@@ -780,7 +870,11 @@ draw icons and mouse cursors on the screen.
 	    (set-dc-for-text dc medium ink (acl-font-index font))
 	    (let ((cstr (ct:callocate (:char *) :size 2)))
 	      (ct:cset (:char 2) cstr 0 (char-int char))
-	      (or (win:textOut dc x y cstr 1)
+	      (or #+removed (win:textOut dc x y cstr 1)
+		  (excl:with-native-string (cstr (make-string
+					     1
+					     :initial-element char))
+		    (win:TextOut dc x y cstr 1))
 		  (check-last-error "TextOut" :action :warn)))))
 	(selectobject dc old)))))
 
diff --git a/aclpc/acl-mirror.lisp b/aclpc/acl-mirror.lisp
index 2efcda6e..edad2328 100644
--- a/aclpc/acl-mirror.lisp
+++ b/aclpc/acl-mirror.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: acl-mirror.lisp,v 1.8 1999/02/25 08:23:25 layer Exp $
+;; $Id: acl-mirror.lisp,v 1.9 1999/05/04 01:21:00 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -295,8 +295,10 @@
   (let ((window (sheet-mirror sheet)))
     (unless *in-layout-avp*
       (win:ShowWindow window win:SW_SHOW) ; returns NIL if it was already visible.
+      ;; Don't signal errors for UpdateWindow, just warn. JPM 3/19/99.
       (or (win:UpdateWindow window)	; send a WM_PAINT message
-	  (check-last-error "UpdateWindow")))))
+	  (check-last-error "UpdateWindow" :action :warn))
+      )))
 
 (defmethod disable-mirror ((port acl-port) sheet)
   (win:ShowWindow (sheet-mirror sheet) win:SW_HIDE))
@@ -370,15 +372,19 @@
     (values (coordinate 0) (coordinate 0)
 	    (- c a) (- d b))))
 
+(defvar *setting-sheet-mirror* nil)
+
 (defmethod set-sheet-mirror-edges* ((port acl-port) sheet
 				    left top right bottom)
   ;; unspecialized (not top)
   (fix-coordinates left top right bottom)
-  (win:SetWindowPos (sheet-mirror sheet)
-		    0 ; we really want win:HWND_TOP
-		    left top (- right left) (- bottom top)
-		    (logior win:SWP_NOACTIVATE
-			    win:SWP_NOZORDER)))
+  (unless (eq sheet *setting-sheet-mirror*) ; avoid recursion bug
+    (let ((*setting-sheet-mirror* sheet))
+      (win:SetWindowPos (sheet-mirror sheet)
+			0		; we really want win:HWND_TOP
+			left top (- right left) (- bottom top)
+			(logior win:SWP_NOACTIVATE
+				win:SWP_NOZORDER)))))
 
 (defvar *port-mirror-sheet-alist* nil)
 
@@ -529,8 +535,7 @@
   ;; Set the "inside" size of a top-level sheet.
   ;; Top-level sheet has to account for sizes of window decorations.
   (fix-coordinates left top right bottom)
-  (multiple-value-bind (wleft wtop wright wbottom) (mirror-region* port
-sheet)
+  (multiple-value-bind (wleft wtop wright wbottom) (mirror-region* port sheet)
     (when (and (= left wleft) (= top wtop)
 	       (= right wright) (= bottom wbottom))
       ;; We seem to get infinite recursion if we don't check for this.
diff --git a/aclpc/acl-port.lisp b/aclpc/acl-port.lisp
index 08aa92f9..d3634c17 100644
--- a/aclpc/acl-port.lisp
+++ b/aclpc/acl-port.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: acl-port.lisp,v 1.9 1999/02/25 08:23:25 layer Exp $
+;; $Id: acl-port.lisp,v 1.10 1999/05/04 01:21:00 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -137,30 +137,35 @@
   
 (define-constructor make-acl-event-queue queue () )
 
-;; reinstated the text-style->acl-font-mapping table (and commented
-;; out font-cache-style/font slots) because we now need to have
-;; multiple logical fonts open simultaneously for the life time of any
-;; controls for which a :text-style is specified. Before, only the 
-;; Windows system font was being used and text-style-mapping was only
-;; used to put stuff in device contexts which only lived inside a
-;; with-dc - besides which the *original-font*, *created-font* logic
-;; was suspect. (cim 10/14/96)
-
 (defclass acl-port (basic-port)
-  ((dc-cache :initform (make-hash-table) :accessor port-dc-cache)
-   (text-style->acl-font-mapping :initform (make-hash-table)) 
+  (;; Cache used by dc-image-for-ink for mapping inks to device contexts:
+   (dc-cache :initform (make-hash-table) :accessor port-dc-cache)
+   ;; Virtual key to keysym:
    (vk->keysym :initform (make-hash-table))
-   (keysym->keysym :initform (make-hash-table))
+   ;; Cached value of (win:GetDeviceCaps dc win:LOGPIXELSY) :
    logpixelsy
+   ;; Where window events get put:
    (event-queue :initform (make-acl-event-queue))
+   ;; Most recently activated window or control:
    (mirror-with-focus :initform nil :accessor acl-port-mirror-with-focus)
-   (pointer-sheet :initform nil)
-   (motion-pending :initform nil)
+   ;; Cache used by realize-cursor:
    (cursor-cache :initform nil)
+   ;; Support for pointer grabbing:
    (grab-cursor :initform nil :accessor port-grab-cursor)
+   ;; Default foreground, background colors:
    (resources :initform nil :accessor port-default-resources)
+   ;; Four slots for cached pointer state:
    (pointer-x :initform 0)
-   (pointer-y :initform 0)))
+   (pointer-y :initform 0)
+   (pointer-sheet :initform nil)
+   (motion-pending :initform nil)
+   ;; Cached mapping of CLIM text styles to operating system fonts:
+   (text-style->acl-font-mapping :initform (make-hash-table)) 
+   ;; Drawing text at an angle is implemented by asking the
+   ;; operating system to rotate a font to the required angle:
+   (rotated-font-htable :initform (make-hash-table)
+			:accessor port-rotated-font-htable)   
+   ))
 
 (defmethod restart-port ((port acl-port))
   ;; No need to devote a thread to receiving messages
@@ -303,10 +308,131 @@
 		(:very-large 18)
 		(:huge       24)))
 
-;;--- hacked to allow text-styles to be specified as lists
-;;--- there's probably a more efficient way...
-(defmethod text-style-mapping ((port acl-port) (style list)
-			       &optional (character-set *standard-character-set*) etc)
+(defmethod port-find-rotated-font ((port acl-port) 
+				   plain-font font-rotation-angle)
+  ;; Find the rotated-font corresponding to plain-font
+  ;; rotated at the appropriate angle.
+  ;; If it doesn't exist, create it and cache a record
+  ;; of it.
+  (let ((htable (port-rotated-font-htable port)))
+    (let ((base-font-list (gethash plain-font htable)))
+      (let ((font-pair (and base-font-list
+			    (find font-rotation-angle base-font-list 
+				  :test #'=
+				  :key #'first))))
+	(cond (font-pair
+	       (second font-pair))
+	      (t
+	       (let ((new-font (port-duplicate-rotated-windows-font 
+				port plain-font font-rotation-angle)))
+		 (push (list font-rotation-angle new-font)
+		       (gethash plain-font htable))
+		 new-font)))))))
+
+(defmethod port-duplicate-rotated-windows-font 
+    ((port acl-port) plain-font font-rotation-angle)
+  (let ((text-style (port-acl-font->text-style port plain-font)))
+    (cond (text-style 
+	   (text-style-mapping-1 
+	    port text-style 
+	    :font-rotation-angle font-rotation-angle))
+	  (t 
+	   ;;; Make a best guess.
+	   (let ((old-height (acl-font-height plain-font))
+		 (italic-flag (acl-font-italic plain-font))
+		 (underline-flag (acl-font-underlined plain-font))
+		 (weight-flag (acl-font-weight plain-font)))
+	     (make-windows-font 
+	      old-height 
+	      :escapement font-rotation-angle
+	      :orientation font-rotation-angle
+	      :italic (not (= italic-flag 0))
+	      :underline (not (= underline-flag 0))
+	      :weight weight-flag
+	      ))))))
+
+(defun pos-to-font-angle (x0 y0 x1 y1)
+  (let ((dx (if (null x1) 0 (- x1 x0)))
+	(dy (if (null y1) 0 (- y0 y1))))
+    (cond ((= dy 0)
+	   (if (< dx 0)
+	       -1800
+	     0))
+	  ((= dx 0)
+	   (if (< dy 0)
+	       -900
+	     900))
+	  (t
+	   (let* ((angfact #.(/ 180 pi))
+		  (ang (* (atan dy dx) angfact)))
+	     (round (* 10 ang)))))))
+
+(defmethod port-acl-font->text-style ((port acl-port) acl-font)
+  (with-slots (text-style->acl-font-mapping) port
+    (when text-style->acl-font-mapping
+      (catch :font-found 
+	(maphash #'(lambda (KEY VAL)
+		     (if (eql VAL ACL-FONT)
+			 (throw :font-found KEY)))
+		 text-style->acl-font-mapping)))))
+
+(defmethod text-style-mapping-1
+    ((port acl-port) (style text-style) &key font-rotation-angle)
+  (multiple-value-bind (weight italic)
+      (let ((face (text-style-face style)))
+	(typecase face
+	  (cons
+	   (values (if (member :bold face) win:FW_BOLD win:FW_NORMAL)
+		   (member :italic face)))
+	  (otherwise
+	   (case face
+	     (:roman (values win:FW_NORMAL nil))
+	     (:bold (values win:FW_BOLD nil))
+	     (:italic (values win:FW_NORMAL t))
+	     (otherwise (values win:FW_BOLD nil))))))
+    (multiple-value-bind (family face-name)
+	(case (text-style-family style)
+	  (:fix (values (logior win:FIXED_PITCH win:FF_MODERN)
+			#+ignore
+			"courier"))
+	  (:serif (values (logior win:VARIABLE_PITCH win:FF_ROMAN)
+			  "times new roman"))
+	  (:sans-serif (values (logior win:VARIABLE_PITCH win:FF_SWISS)
+			       "arial"))
+	  ;;--- some of these specify ugly ugly linedrawn fonts
+	  (otherwise (values (logior win:DEFAULT_PITCH win:FF_DONTCARE)
+			     (string (text-style-family style)))))
+      (let ((size (text-style-size style))
+	    (point-size nil))
+	(when (numberp size)
+	  (setq point-size size))
+	(unless point-size
+	  (setq point-size
+	    (second (assoc size *acl-logical-size-alist*))))
+	(unless point-size
+	  (format *trace-output*
+		  "~& Warning: ~S does not specify size, using 12" style)
+	  (setq point-size 12))
+	(if font-rotation-angle 
+	    (make-windows-font 
+	     (- (round (* point-size (slot-value port 'logpixelsy)) 72))
+	     :weight weight 
+	     :italic italic
+	     :pitch-and-family family 
+	     :face face-name	  
+	     :escapement font-rotation-angle
+	     :orientation font-rotation-angle)
+	  (make-windows-font 
+	   (- (round (* point-size (slot-value port 'logpixelsy)) 72))
+	   :weight weight 
+	   :italic italic
+	   :pitch-and-family family 
+	   :face face-name	  
+	   ))))))
+
+(defmethod text-style-mapping 
+    ((port acl-port) (style list)
+     &optional (character-set *standard-character-set*) etc)
   (text-style-mapping port (apply #'make-text-style style)
 		      character-set etc))
 
@@ -317,47 +443,7 @@
   (with-slots (text-style->acl-font-mapping) port
     (or (gethash style text-style->acl-font-mapping)
 	(setf (gethash style text-style->acl-font-mapping)
-	  (multiple-value-bind (weight italic)
-	      (let ((face (text-style-face style)))
-		(typecase face
-		  (cons
-		   (values (if (member :bold face) win:FW_BOLD win:FW_NORMAL)
-			   (member :italic face)))
-		  (otherwise
-		   (case face
-		     (:roman (values win:FW_NORMAL nil))
-		     (:bold (values win:FW_BOLD nil))
-		     (:italic (values win:FW_NORMAL t))
-		     (otherwise (values win:FW_BOLD nil))))))
-	    (multiple-value-bind (family face-name)
-		(case (text-style-family style)
-		  (:fix (values (logior win:FIXED_PITCH win:FF_MODERN) 
-				#+ignore
-				"courier"))
-		  (:serif (values (logior win:VARIABLE_PITCH win:FF_ROMAN)
-				  "times new roman"))
-		  (:sans-serif (values (logior win:VARIABLE_PITCH win:FF_SWISS)
-				       "arial"))
-		  ;;--- some of these specify ugly ugly linedrawn fonts
-		  (otherwise (values (logior win:DEFAULT_PITCH win:FF_DONTCARE)
-				     (string (text-style-family style)))))
-	      (let ((size (text-style-size style))
-		    (point-size nil))
-		(when (numberp size)
-		  (setq point-size size))
-		(unless point-size
-		  (setq point-size
-		    (second (assoc size *acl-logical-size-alist*))))
-		(unless point-size
-		  (format *trace-output*
-			  "~& Warning: ~S is not a known size, using 12" size)
-		  (setq point-size 12))
-		(make-windows-font 
-		 (- (round (* point-size (slot-value port 'logpixelsy)) 72))
-		 :weight weight 
-		 :italic italic
-		 :pitch-and-family family 
-		 :face face-name))))))))
+	  (text-style-mapping-1 port style)))))
 
 (defmethod text-style-mapping
     ((device acl-port) (style silica::device-font)
@@ -379,7 +465,8 @@
 	 (array (make-array (1+ last-character))))
     (loop for i from first-character to last-character do
 	  (setf (char string 0) (code-char i))
-	  (cond ((win:getTextExtentPoint dc string 1 tepsize)
+	  (cond ((excl:with-native-string (string string)
+		   (win:getTextExtentPoint dc string 1 tepsize))
 		 (setf (aref array i) (ct:cref win:size tepsize cx)))
 		(t
 		 ;; Why does this clause ever run?  getlasterror=10035.
@@ -411,21 +498,22 @@
 		 win-font) 
   (unless win-font
     (setq win-font
-      (win:createFont height		; logical height
-		      width		; logical average width
-		      escapement	; angle of escapement (tenths of degrees)
-		      orientation	; normally the same as escapement
-		      weight		; font weight (FW_NORMAL=400, FW_BOLD=700)
-		      (if italic 1 0) 
-		      (if underline 1 0)
-		      (if strikeout 1 0) 
-		      charset		; if you want chinese or greek
-		      output-precision
-		      clip-precision
-		      quality
-		      pitch-and-family 
-		      (or face "")
-		      )))
+      (excl:with-native-string (vface (or face ""))
+	(win:createFont height		; logical height
+			width		; logical average width
+			escapement	; angle of escapement (tenths of degrees)
+			orientation	; normally the same as escapement
+			weight		; font weight (FW_NORMAL=400, FW_BOLD=700)
+			(if italic 1 0) 
+			(if underline 1 0)
+			(if strikeout 1 0) 
+			charset		; if you want chinese or greek
+			output-precision
+			clip-precision
+			quality
+			pitch-and-family 
+			vface
+			))))
   (when (zerop win-font)
     (check-last-error "CreateFont"))
   (make-device-font win-font))
diff --git a/aclpc/acl-prel.lisp b/aclpc/acl-prel.lisp
index a854f2a9..c68d07fc 100644
--- a/aclpc/acl-prel.lisp
+++ b/aclpc/acl-prel.lisp
@@ -15,7 +15,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: acl-prel.lisp,v 1.8 1999/02/25 08:23:25 layer Exp $
+;; $Id: acl-prel.lisp,v 1.9 1999/05/04 01:21:00 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -46,23 +46,25 @@
 			 (scroll-mode (combobox-scroll-bars items)))
   (declare (ignore id))
   (let* ((hwnd
-	  (win:CreateWindowEx 
-	   0				; extended-style
-	   "COMBOBOX"			; classname
-	   (nstringify label)		; windowname
-	   (logior
-	    (if (member scroll-mode '(:vertical :both t :dynamic)) 
-		win:WS_VSCROLL
-	      0)
-	    (if (member scroll-mode '(:horizontal :both t :dynamic)) 
-		win:WS_HSCROLL
-	      0)
-	    win:WS_CHILD
-	    win:WS_TABSTOP
-	    win:CBS_DROPDOWNLIST)
-	   0 0 0 0
-	   parent (ct::null-handle win::hmenu)
-	   *hinst* (symbol-name (gensym)))))
+	  (excl:with-native-string (x "COMBOBOX")
+	    (excl:with-native-string (label (nstringify label))
+	      (win:CreateWindowEx 
+	       0			; extended-style
+	       x			; classname
+	       label			; windowname
+	       (logior
+		(if (member scroll-mode '(:vertical :both t :dynamic)) 
+		    win:WS_VSCROLL
+		  0)
+		(if (member scroll-mode '(:horizontal :both t :dynamic)) 
+		    win:WS_HSCROLL
+		  0)
+		win:WS_CHILD
+		win:WS_TABSTOP
+		win:CBS_DROPDOWNLIST)
+	       0 0 0 0
+	       parent (ct::null-handle win::hmenu)
+	       *hinst* (symbol-name (gensym)))))))
     (if (ct:null-handle-p hwnd hwnd)
 	;; failed
 	(cerror "proceed" "failed")
@@ -78,7 +80,8 @@
 	  (dolist (item items)
 	    (setf item-name (funcall name-key item))
 	    (incf index)
-	    (win:SendMessage hwnd win:CB_INSERTSTRING index item-name)
+	    (excl:with-native-string (item-name item-name)
+	      (win:SendMessage hwnd win:CB_INSERTSTRING index item-name))
 	    ))
 	(win:SendMessage hwnd win:CB_SETCURSEL (or value 0) 0)
 	(win:SendMessage hwnd CB_SETTOPINDEX (or value 0) 0)))
@@ -121,15 +124,17 @@
 	   win:WS_CLIPSIBLINGS))
 	 (exstyle win:WS_EX_CLIENTEDGE)
 	 (hwnd
-	  (win:CreateWindowEx exstyle
-			      "LISTBOX"	; classname
-			      (nstringify label) ; windowname
-			      style
-			      0 0 0 0
-			      parent
-			      (ct::null-handle win::hmenu)
-			      *hinst*
-			      (symbol-name (gensym)))))
+	  (excl:with-native-string (classname "LISTBOX")
+	    (excl:with-native-string (windowname (nstringify label))
+	      (win:CreateWindowEx exstyle
+				  classname ; classname
+				  windowname ; windowname
+				  style
+				  0 0 0 0
+				  parent
+				  (ct::null-handle win::hmenu)
+				  *hinst*
+				  (symbol-name (gensym)))))))
     (if (ct:null-handle-p hwnd hwnd)
 	;; failed
 	(cerror "proceed" "failed")
@@ -152,7 +157,8 @@
 	      (ct:cset (:char 256) cstr ((fixnum i))
 		       (char-int (char item-name i))))
 	    (incf index)
-	    (win:SendMessage hwnd win:LB_INSERTSTRING index item-name)
+	    (excl:with-native-string (item-name item-name)
+	      (win:SendMessage hwnd win:LB_INSERTSTRING index item-name))
 	    ))
 	(if (eq mode :nonexclusive)
 	    (let ((i 0))
@@ -186,21 +192,23 @@
 
 (defun scrollbar-open (parent left top width height orientation)
   (let* ((hwnd
-	  (win:CreateWindowEx 
-	   0				; style
-	   "SCROLLBAR"			; classname
-	   (nstringify "")		; windowname
-	   (logior (if (eql orientation :horizontal) 
-		       win::SBS_HORZ win::SBS_VERT)
-		   win::WS_CHILD
-		   win::WS_BORDER
-		   win::WS_CLIPCHILDREN 
-		   win::WS_CLIPSIBLINGS) ; style
-	   0 0 0 0			; x, y, width, height
-	   parent
-	   (ct:null-handle win::hmenu)
-	   *hinst*
-	   (symbol-name (gensym)))))
+	  (excl:with-native-string (classname "SCROLLBAR")
+	    (excl:with-native-string (windowname (nstringify ""))
+	      (win:CreateWindowEx 
+	       0			; style
+	       classname		; classname
+	       windowname		; windowname
+	       (logior (if (eql orientation :horizontal) 
+			   win::SBS_HORZ win::SBS_VERT)
+		       win::WS_CHILD
+		       win::WS_BORDER
+		       win::WS_CLIPCHILDREN 
+		       win::WS_CLIPSIBLINGS) ; style
+	       0 0 0 0			; x, y, width, height
+	       parent
+	       (ct:null-handle win::hmenu)
+	       *hinst*
+	       (symbol-name (gensym)))))))
     (if (ct:null-handle-p hwnd hwnd)
 	;; failed
 	(cerror "proceed" "failed")
@@ -230,19 +238,21 @@
   ;; Both push buttons and radio buttons are created here.
   (let* ((nlabel (cleanup-button-label label))
 	 (hwnd
-	  (win:CreateWindowEx 0
-			       "BUTTON"	; classname
-			       (nstringify nlabel) ; windowname
-			       (logior buttonstyle
-				       win:WS_TABSTOP
-				       win:WS_CHILD
-				       win:WS_CLIPCHILDREN 
-				       win:WS_CLIPSIBLINGS) ; style
-			       0 0 0 0
-			       parent
-			       (ct::null-handle win::hmenu)
-			       *hinst*
-			       (symbol-name (gensym)))))
+	  (excl:with-native-string (classname "BUTTON")
+	    (excl:with-native-string (windowname (nstringify nlabel) )
+	      (win:CreateWindowEx 0
+				  classname ; classname
+				  windowname ; windowname
+				  (logior buttonstyle
+					  win:WS_TABSTOP
+					  win:WS_CHILD
+					  win:WS_CLIPCHILDREN 
+					  win:WS_CLIPSIBLINGS) ; style
+				  0 0 0 0
+				  parent
+				  (ct::null-handle win::hmenu)
+				  *hinst*
+				  (symbol-name (gensym)))))))
     (if (ct:null-handle-p hwnd hwnd)
 	;; failed
 	(cerror "proceed" "failed")
@@ -266,37 +276,40 @@
 			(scroll-mode nil))
   (declare (ignore id))
   (let* ((hwnd
-	  (win:CreateWindowEx 
-	   win:WS_EX_CLIENTEDGE
-	   "EDIT"			; classname
-	   (nstringify label)		; windowname
-	   (logior editstyle
-		   win:WS_CHILD
-		   win:WS_BORDER
-		   win:WS_TABSTOP
-		   (if (member scroll-mode '(:horizontal :both t :dynamic))
-		       win:WS_HSCROLL
-		     0)
-		   (if (member scroll-mode '(:vertical :both t :dynamic))
-		       win:WS_VSCROLL
-		     0)
+	  (excl:with-native-string (classname "EDIT")
+	    (excl:with-native-string (windowname (nstringify label))
+	      (win:CreateWindowEx 
+	       win:WS_EX_CLIENTEDGE
+	       classname		; classname
+	       windowname		; windowname
+	       (logior editstyle
+		       win:WS_CHILD
+		       win:WS_BORDER
+		       win:WS_TABSTOP
+		       (if (member scroll-mode '(:horizontal :both t :dynamic))
+			   win:WS_HSCROLL
+			 0)
+		       (if (member scroll-mode '(:vertical :both t :dynamic))
+			   win:WS_VSCROLL
+			 0)
 					   
-		   win:WS_CLIPCHILDREN 
-		   win:WS_CLIPSIBLINGS)	; style
-	   0 0 0 0
-	   parent
-	   (ct::null-handle win::hmenu)
-	   *hinst*
-	   (symbol-name (gensym)))))
+		       win:WS_CLIPCHILDREN 
+		       win:WS_CLIPSIBLINGS) ; style
+	       0 0 0 0
+	       parent
+	       (ct::null-handle win::hmenu)
+	       *hinst*
+	       (symbol-name (gensym)))))))
     (if (ct:null-handle-p hwnd hwnd)
 	;; failed
 	(cerror "proceed" "failed")
       ;; else succeed if we can init the DC
       (progn
 	(if (stringp value)
-	    (win:SetWindowText 
-	     hwnd 
-	     (silica::xlat-newline-return value)))
+	    (excl:with-native-string (s1 (silica::xlat-newline-return value))
+	      (win:SetWindowText 
+	       hwnd 
+	       s1)))
 	;; Override the default window proc.
 	(progn				;+++
 	  (setf std-ctrl-proc-address
@@ -365,19 +378,60 @@
 (defmethod get-texture (device-context pixel-map bitmapinfo)
   ;; The value of this function becomes the dc-image-bitmap.
   ;; It gets applied to the device context using SELECT-OBJECT.
-  (unless (and device-context (not (zerop device-context)))
-    (error "Device context not valid"))
-  (let* (texture-handle)
-    ;; Create nondiscardable Device Dependent Bitmap.
-    ;; The Windows docs suggest we should be using device independent bitmaps.
-    (setq texture-handle
-      (win:CreateDIBitmap
-       device-context
-       bitmapinfo 
-       win:CBM_INIT			; initialize bitmap bits
-       pixel-map
-       bitmapinfo 
-       win:DIB_RGB_COLORS))
+  ;; Pixel-map is an array of integers.  The element type is
+  ;; specific to bits-per-pixel specified in the BMP file.
+  ;;
+  ;; Create nondiscardable Device Dependent Bitmap.
+  ;; The Windows docs suggest we should be using device independent bitmaps.
+  (let* ((dc (win:GetDC 0))
+	 (texture-handle
+	  (win:CreateDIBitmap
+	   dc
+	   bitmapinfo 
+	   win:CBM_INIT			; initialize bitmap bits
+	   pixel-map
+	   bitmapinfo 
+	   win:DIB_RGB_COLORS)))
+    (when (zerop texture-handle)
+      ;;Below is Charley Cox's May 6 message from bug5991 (common graphics)
+      ;;
+      ;;The workaround I have installed to open-texture (the only place that
+      ;;calls CreateDIBitmap) occurs when an initial call to CreateDIBitmap
+      ;;fails.  If a failure occurs, open-texture does an on-the-spot copy of
+      ;;the pixmap array into a malloc'd block and then tries calling
+      ;;CreateDIBitmap again.  Afterwards, it frees the malloc'd block.
+      ;;
+      ;;This workaround has fixed all the failure cases I was able to
+      ;;reproduce, and I have not seen any failures since its installation.  I
+      ;;have also since not seen any StretchDIBits failures.
+      ;;
+      ;;I'm not really happy not knowing what was causing CreateDIBitmap's
+      ;;failure.  The GetLastError code was not being set, and single stepping
+      ;;all the way through did not reveal anything.  It's possible we may
+      ;;revisit this in the future.
+      (let (width height bits-per-pixel)
+	(let ((d (array-dimensions pixel-map)))
+	  (setq width (first d) height (second d)))
+	(setq bits-per-pixel 8)		; kludge
+	(let* ((image-size
+		;; Formula from msdn document: SAMPLE: DIBs and Their Uses
+		(* (ash
+		    (logand (+ (* width bits-per-pixel) 31)
+			    #.(lognot 31))
+		    -3)
+		   height))
+	       (malloc-texture-array
+		(ff:allocate-fobject `(:array :char ,image-size) :c)))
+	  (unless (zerop malloc-texture-array)
+	    (memcpy malloc-texture-array pixel-map image-size))
+	  (setq texture-handle
+	    (win:CreateDIBitmap
+	     device-context
+	     bitmapinfo 
+	     win:CBM_INIT		; initialize bitmap bits
+	     pixel-map
+	     bitmapinfo 
+	     win:DIB_RGB_COLORS)))))
     (when (zerop texture-handle)
       (check-last-error "CreateDIBitmap"))
     texture-handle))
@@ -485,3 +539,4 @@
 		   (values (funcall parser string) string))))
 	(win:CloseClipboard))
     (check-last-error "OpenClipboard")))
+
diff --git a/aclpc/acl-widget.lisp b/aclpc/acl-widget.lisp
index 231e7d45..20675f68 100644
--- a/aclpc/acl-widget.lisp
+++ b/aclpc/acl-widget.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: acl-widget.lisp,v 1.11 1999/02/25 08:23:25 layer Exp $
+;; $Id: acl-widget.lisp,v 1.12 1999/05/04 01:21:00 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -178,7 +178,8 @@
 	(let ((str (acl-clim::nstringify (funcall name-key item)))
 	      (pos (position item items)))
 	  ;;(break "insert gadget item [~a @ ~a]" str pos)
-	  (win:SendMessage mirror win:LB_INSERTSTRING pos str)))
+	  (excl:with-native-string (str str)
+	    (win:SendMessage mirror win:LB_INSERTSTRING pos str))))
       (win:InvalidateRect mirror ct:hnull win:TRUE)))) ;; make sure it updates
 
 (defmethod acl-clim::command-event :around ((gadget hlist-pane) 
@@ -375,7 +376,8 @@
 	;; Don't redraw till I tell you:
 	(win:SendMessage mirror win:WM_SETREDRAW 0 0)
 	;; Here's the text:
-	(win:SetWindowText mirror (xlat-newline-return new))
+	(excl:with-native-string (s1 (xlat-newline-return new))
+	  (win:SetWindowText mirror s1))
 	;; Try to preserve the scroll position:
 	(win:SendMessage mirror win:EM_LINESCROLL leftchar topline)
 	;; Redraw now:
@@ -388,10 +390,12 @@
 	(let* ((wl (win:SendMessage mirror 
 				    win:WM_GETTEXTLENGTH 
 				    0 0))
-	       (teb (make-string wl))
+	       (teb
+		#+removed (make-string wl)
+		(make-array wl :element-type '(unsigned-byte 8)))
 	       (tlen (win:GetWindowText mirror teb (1+ wl))))
 	  (declare (ignorable tlen))
-	  (setf teb (unxlat-newline-return teb)) 
+	  (setf teb (unxlat-newline-return (excl:mb-to-string teb)))
 	  (setf value teb)
 	  ;; By the way, does anyone know why 
 	  ;; the second value is returned? -smh
@@ -606,7 +610,8 @@
 (defmethod (setf gadget-label) :after (str (pane hpbutton-pane))
   (with-slots (mirror) pane
     (when mirror
-      (win:SetWindowText mirror str))))
+      (excl:with-native-string (str str)
+	(win:SetWindowText mirror str)))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -809,7 +814,8 @@
 	(let ((str (acl-clim::nstringify (funcall name-key item)))
 	      (pos (position item items)))
 	  ;;(break "insert gadget item [~a @ ~a]" str pos)
-	  (win:SendMessage mirror win:CB_INSERTSTRING pos str)))
+	  (excl:with-native-string (str str)
+	    (win:SendMessage mirror win:CB_INSERTSTRING pos str))))
       ;; make sure it updates
       (win:InvalidateRect mirror ct:hnull win:TRUE)
       (note-sheet-region-changed pane))))
@@ -1325,15 +1331,17 @@
 	(exstyle win:WS_EX_CLIENTEDGE)
 	(window nil))
     (setq window
-      (win:CreateWindowEx exstyle
-			  *clim-class*
-			  *win-name*
-			  winstyle
-			  left top width height
-			  (or parent 0)
-			  0		; menu
-			  *hinst*
-			  (symbol-name (gensym)) )) 
+      (excl:with-native-string (*clim-class* *clim-class*)
+	(excl:with-native-string (*win-name* *win-name*)
+	  (win:CreateWindowEx exstyle
+			      *clim-class*
+			      *win-name*
+			      winstyle
+			      left top width height
+			      (or parent 0)
+			      0		; menu
+			      *hinst*
+			      (symbol-name (gensym)) )))) 
     (when (zerop window)
       (or (check-last-error "CreateWindowEx")
 	  (error "CreateWindowEx: unknown error")))
diff --git a/aclpc/pkgdcl.lisp b/aclpc/pkgdcl.lisp
index ac64317d..24b9791f 100644
--- a/aclpc/pkgdcl.lisp
+++ b/aclpc/pkgdcl.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: pkgdcl.lisp,v 1.4 1999/02/25 08:23:27 layer Exp $
+;; $Id: pkgdcl.lisp,v 1.5 1999/05/04 01:21:01 layer Exp $
 
 (in-package :common-lisp-user)
 
@@ -30,8 +30,9 @@
   ;;(require :for)			; for FOR macro
   (require :winapi)
   (require :winapi-dev)
-  (load "user32.dll")
-
+  ;; Kevin: (FEATUREP (:VERSION>= 5 (0 1) :PRE-BETA2)) throws an error
+  (or (ignore-errors (load "user32.dll" :system-library t))
+      (load "user32.dll"))
   ;; Turn this off as long as clim-utils is a locked package.
   (setq excl:*enable-package-locked-errors* nil)
   )
diff --git a/aclpc/winwidgh.lisp b/aclpc/winwidgh.lisp
index 7b2fd033..5b8c8be3 100644
--- a/aclpc/winwidgh.lisp
+++ b/aclpc/winwidgh.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: winwidgh.lisp,v 1.5 1999/02/25 08:23:27 layer Exp $
+;; $Id: winwidgh.lisp,v 1.6 1999/05/04 01:21:03 layer Exp $
 
 (in-package :acl-clim)
 
@@ -95,3 +95,7 @@
 (ff:def-foreign-call (CallNextHookEx "CallNextHookExA")
     ((a :int) (b :int) (c :int) (d :int))
   :returning :int)
+
+(ff:def-foreign-call memcpy
+    ((to (* :char)) (from (* :char)) (nbytes :int))
+  :returning :int)
diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index 5737e3ab..997d3e4e 100644
--- a/clim/accept-values.lisp
+++ b/clim/accept-values.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: accept-values.lisp,v 1.85 1999/02/25 08:23:27 layer Exp $
+;; $Id: accept-values.lisp,v 1.86 1999/05/04 01:21:03 layer Exp $
 
 (in-package :clim-internals)
 
@@ -1670,21 +1670,22 @@
   (updating-output (stream :unique-id query-identifier :id-test #'equal
                            :cache-value (cons active-p cache-value)
                            :cache-test #'(lambda (x y)
-                                           (and (eq (car x) (car y))
+                                           (and (consp x) (consp y)
+						(eq (car x) (car y))
                                                 (funcall cache-test (cdr x) (cdr y)))))
     (labels ((update-gadget (record gadget)
-                        (declare (ignore record))            ;;-- This sucks
-                        (setf (gadget-label gadget) (compute-prompt))
-                        (if active-p
-                            (activate-gadget gadget)
-                          (deactivate-gadget gadget)))
+	       (declare (ignore record))            ;;-- This sucks
+	       (setf (gadget-label gadget) (compute-prompt))
+	       (if active-p
+		   (activate-gadget gadget)
+		 (deactivate-gadget gadget)))
              (compute-prompt ()
                (if (stringp prompt)
                    prompt
-                 ;;-- Does this suck or what???
-                 ;;-- If you do a
-                 ;;surrounding-output-with-border without
-                 ;;this write-string output does not get bordered.
+		 ;;-- Does this suck or what???
+		 ;;-- If you do a
+		 ;;surrounding-output-with-border without
+		 ;;this write-string output does not get bordered.
                  (let ((*original-stream* nil))
                    (apply #'pixmap-from-menu-item
                           stream prompt #'funcall nil
@@ -1692,30 +1693,30 @@
                           (view-gadget-initargs view)))))
              (doit (stream)
                (with-output-as-gadget (stream  :update-gadget #'update-gadget)
-                   (let ((record (stream-current-output-record (encapsulating-stream-stream stream)))
-                         (client (make-instance 'accept-values-command-button
-                                                :continuation continuation
-                                                :documentation documentation
-                                                :resynchronize resynchronize)))
-                     (make-pane-from-view
-                      'push-button
-                      view ()
-                      :id record :client client
-                      :activate-callback #'(lambda (button)
-                                             (when (accept-values-query-valid-p nil record) ;---can't be right
-                                               (let ((sheet (sheet-parent button)))
-                                                 (process-command-event
-                                                  sheet
-                                                  (allocate-event 'presentation-event
-                                                                  :sheet sheet
-                                                                  :echo nil
-                                                                  :presentation-type 'command
-                                                                  :value `(com-avv-command-button ,client ,record)
-                                                                  :frame *application-frame*)))))
-                      :label (compute-prompt)
-                      :name :accept-values-command-button
-                      :help-callback documentation
-                      :active active-p)))))
+		 (let ((record (stream-current-output-record (encapsulating-stream-stream stream)))
+		       (client (make-instance 'accept-values-command-button
+				 :continuation continuation
+				 :documentation documentation
+				 :resynchronize resynchronize)))
+		   (make-pane-from-view
+		    'push-button
+		    view ()
+		    :id record :client client
+		    :activate-callback #'(lambda (button)
+					   (when (accept-values-query-valid-p nil record) ;---can't be right
+					     (let ((sheet (sheet-parent button)))
+					       (process-command-event
+						sheet
+						(allocate-event 'presentation-event
+								:sheet sheet
+								:echo nil
+								:presentation-type 'command
+								:value `(com-avv-command-button ,client ,record)
+								:frame *application-frame*)))))
+		    :label (compute-prompt)
+		    :name :accept-values-command-button
+		    :help-callback documentation
+		    :active active-p)))))
       (let ((align-prompts (slot-value stream 'align-prompts)))
         (if align-prompts
             (formatting-row (stream)
diff --git a/clim/frames.lisp b/clim/frames.lisp
index cb196cab..17308959 100644
--- a/clim/frames.lisp
+++ b/clim/frames.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: frames.lisp,v 1.92 1999/02/25 08:23:29 layer Exp $
+;; $Id: frames.lisp,v 1.93 1999/05/04 01:21:04 layer Exp $
 
 (in-package :clim-internals)
 
@@ -862,7 +862,8 @@
 			  (frame-standard-output frame))))
 	      (typecase si
 		(output-protocol-mixin si)
-		(t (frame-top-level-sheet frame))))))
+		(t (frame-top-level-sheet frame)))))
+	   (*avv-refreshed* nil))
       ;; The read-eval-print loop for applications...
       (letf-globally (((frame-actual-pointer-documentation-pane frame)
 		       *pointer-documentation-output*))
@@ -870,6 +871,12 @@
 	  ;; Redisplay all the panes
 	  (catch-abort-gestures ("Return to ~A command level" (frame-pretty-name frame))
 	    (redisplay-frame-panes frame)
+	    (when (not *avv-refreshed*) 
+	      ;;; This needs to happen after the 
+	      ;;; call to redisplay-frame-panes
+	      ;;; but only do it the first time.
+	      (force-refresh-avv-streams FRAME)
+	      (setq *avv-refreshed* t))
 	    (when interactor
 	      (fresh-line *standard-input*)
 	      (if (stringp prompt)
@@ -881,6 +888,24 @@
 	      ;; Need this check in case the user aborted out of a command menu
 	      (when command
 		(execute-frame-command frame command)))))))))
+
+(defmethod force-refresh-avv-streams (frame)
+  ;;; NOTE:  Not using get-frame-pane-to-avv-stream-table.
+  ;;; Don't create the hashtable if it's not already there.
+  (let ((ht (frame-pane-to-avv-stream-table frame)))
+    (when ht
+      (maphash #'(lambda (pane pair) 
+		   pane
+		   (let ((avv-stream (car pair))
+			 (avv-record (cdr pair)))
+		     (and avv-stream
+			  avv-record
+			  (port avv-stream)
+			  (sheet-medium avv-stream)
+			  (redisplay avv-record
+				     avv-stream
+				     :check-overlapping t))))
+	       ht))))
   
 ;; Generic because someone might want :BEFORE or :AFTER
 (defmethod frame-exit ((frame standard-application-frame))
@@ -1143,20 +1168,19 @@
                                )
   (read-command (frame-command-table frame) :stream stream))
 
-
-#+(or aclpc acl86win32)
-(defvar *frame*)
-
 (defmacro with-menu-disabled (frame &body body)
   #-mswindows (declare (ignore frame))
+  #-mswindows `(progn ,@body)
   #+mswindows
   `(unwind-protect 
-       (progn (enable-menu-items ,frame nil) ,@body)
-     (enable-menu-items ,frame t)
-     (setq *frame* ,frame))
-  #-mswindows `(progn ,@body))
+       (progn 
+	 (disable-all-menu-items ,frame)
+	 ,@body)
+     (re-enable-menu-items ,frame)))
 
 (defmethod execute-frame-command ((frame standard-application-frame) command)
+  (apply (command-name command) (command-arguments command))
+  #+ignore ;; from jeff on 4/8/99
   (with-menu-disabled frame
     (apply (command-name command) (command-arguments command))))
 
diff --git a/clim/interactive-defs.lisp b/clim/interactive-defs.lisp
index 9ce74255..d3d7fdbb 100644
--- a/clim/interactive-defs.lisp
+++ b/clim/interactive-defs.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: interactive-defs.lisp,v 1.30 1998/08/06 23:15:58 layer Exp $
+;; $Id: interactive-defs.lisp,v 1.31 1999/05/04 01:21:05 layer Exp $
 
 (in-package :clim-internals)
 
@@ -228,7 +228,8 @@
 (defvar *default-input-editing-stream-class*
 #+Allegro
     (excl:ics-target-case
-     (:+ics 'japanese-input-editing-stream)
+     (:+ics #+mswindows 'standard-input-editing-stream
+	    #-mswindows 'japanese-input-editing-stream)
      (:-ics 'standard-input-editing-stream))
 #-Allegro
 	'standard-input-editing-stream)
diff --git a/demo/bitmap-editor.lisp b/demo/bitmap-editor.lisp
index eb9f5b55..07076150 100644
--- a/demo/bitmap-editor.lisp
+++ b/demo/bitmap-editor.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: bitmap-editor.lisp,v 1.22 1999/02/25 08:23:30 layer Exp $
+;; $Id: bitmap-editor.lisp,v 1.23 1999/05/04 01:21:05 layer Exp $
 
 (in-package :clim-demo)
 
@@ -84,16 +84,11 @@
 		"Delete Color"
 		(delete-current-color frame)))))))))
 
-
 (defun replace-current-color (frame)
-  (declare (ignore frame))
-  ;;--- Exercise for the reader
-  )
+  (notify-user frame "Bitmap editor operation not yet implemented"))
 
 (defun delete-current-color (frame)
-  (declare (ignore frame))
-  ;;--- Exercise for the reader
-  )
+  (notify-user frame "Bitmap editor operation not yet implemented"))
 
 (defun add-new-color (frame)
   (let ((fr (make-application-frame 'color-chooser)))
diff --git a/instclimol.lisp b/instclimol.lisp
deleted file mode 100644
index 864714c4..00000000
--- a/instclimol.lisp
+++ /dev/null
@@ -1,33 +0,0 @@
-;; -*- mode: common-lisp; package: system -*-
-;;
-;;				-[Mon Jul  6 15:37:15 1998 by layer]-
-;;
-;; copyright (c) 1991 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
-;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
-;;
-
-;; $Id: instclimol.lisp,v 1.11 1998/08/06 23:15:36 layer Exp $
-
-;;
-;; Load the OpenLook version of CLIM
-;;
-
-(in-package :system)
-
-(load-application (require :climol) :devel system::*devel*)
-
-(format t "~&; Finished loading CLIM OL~%")
-(force-output)
diff --git a/make-symbolic-links.sh b/make-symbolic-links.sh
deleted file mode 100644
index 22a6bd5a..00000000
--- a/make-symbolic-links.sh
+++ /dev/null
@@ -1,50 +0,0 @@
-#!/bin/sh
-#
-# $Header: /repo/cvs.copy/clim2/Attic/make-symbolic-links.sh,v 1.6 1997/05/31 01:00:23 tomj Exp $
-#
-# make a tree of links
-#
-
-# 'original' must be changed whenever the source tree is moved
-# It must be a pathname accessible from any machine on the net
-
-original=/net/romeo/home1/tomj/clim2
-linkdir=$1
-
-if test -z "$linkdir"; then
-	linkdir=.
-fi
-
-echo "linking directory tree $linkdir to $original"
-
-# remove any existing links
-
-if test -d $linkdir; then
-  echo "$linkdir already exists - removing old links"
-  find $linkdir -type l -print | xargs /bin/rm -f
-else
-  echo "creating $linkdir"
-  mkdir $linkdir
-fi
-
-# create the directory tree
-
-for dir in `(cd $original; 
-	     find * -type d -a ! -name CVS -print)` ; do
-	if test ! -d $linkdir/$dir; then 
-	  echo "creating $linkdir/$dir"
-	  mkdir $linkdir/$dir
-	fi
-done
-
-# and now do the links
-
-echo "creating new links"
-
-for file in `(cd $original;
-	      find * -type f ! -name .\* ! -name \*~ ! -name \#\*\# \
-		     -print \
-		      -o -name CVS -prune)` ; do
-	ln -s $original/$file $linkdir/$file
-done
-
diff --git a/makedist.sh b/makedist.sh
deleted file mode 100644
index 9d259e54..00000000
--- a/makedist.sh
+++ /dev/null
@@ -1,23 +0,0 @@
-
-set -xe
-
-make clean
-make RECORD_XREF_INFO=nil RECORD_SOURCE_FILE_INFO=nil CL=../src/lisp
-
-rm -fr dist temp.zip temp.exe
-mkdir dist dist/code dist/src dist/src/clim dist/src/clim/demo
-cp -p climnt.fasl climps.fasl climdemo.fasl climg.fasl dist/code
-cp -p readme.win32 dist/clim221.txt
-cp -p demo/*.lisp dist/src/clim/demo
-cp -p buildclim.cl dist
-
-# next 2 for beta only:
-cp -p ../src/winapi/winapi.fasl dist/code
-cp -p ../src/winapi/winapi-dev.fasl dist/code
-
-/winzip/winzip32 -min -a -r -sclim.me -ex temp.zip dist
-/winzipse/wzipse32 temp.zip -y -3 -win32 -le \
-	-d "c:\Program Files\acl50b" -c notepad clim221.txt
-
-mv temp.zip clim221.zip
-mv temp.exe clim221.exe
diff --git a/readme.win32 b/readme.win32
deleted file mode 100644
index 0b1e8003..00000000
--- a/readme.win32
+++ /dev/null
@@ -1,76 +0,0 @@
-		     CLIM 2.2.1 for ACL 5.0.beta
-			Windows 95 and NT 4.0
-
-Files in this release:
-
-clim221.txt
-    This file.
-code/climnt.fasl
-code/climg.fasl
-code/climps.fasl
-code/climdemo.fasl
-    The above are the fasl files making up the product.
-code/winapi.fasl
-code/winapi-dev.fasl
-    The above are updated fasl with respect to 5.0.beta.
-src/clim/demo/
-    The source files to the CLIM demos.
-
-To use CLIM on Windows evaluate this form:
-	(require :climnt)
-
-To run the CLIM demos, evaluate these forms:
-       (require :climdemo)
-       (clim-demo:start-demo)
-
-There are several known problems with the current release.
-
-1.  This version of CLIM only works in a case insensitive Lisp.  We
-    hope to fix this for the final release.
-
-2.  In this version, you must call run-frame-top-level in the same
-    thread or Lisp "process" that you call
-    make-application-frame. This is a limitation imposed by Windows
-    and is related to the way that SendMessage() must work.  Windows
-    wants a window to be closely linked to the thread that created it.
-    This limitation is not present in UNIX versions of CLIM, and as a
-    result UNIX clim code may not run without some modification.  An
-    error will be signalled if this constraint is violated.  This
-    limitation was not present in the alpha release of CLIM for NT
-    because all Lisp "processes" ran in a single operating system
-    thread.
- 
-    For example, you must replace this:
-      (let ((frame (make-application-frame 'mine)))
-	(mp:process-run-function #'run-frame-top-level frame))
-
-    with something like this:
-      (mp:process-run-function 
-	 #'(lambda () 
-	      (run-frame-top-level (make-application-frame 'mine))))
-
-Changes since the alpha release of CLIM:
-
-1.  CLIM is not distributed as a Lisp image file anymore.  It is
-    distributed as a set of fasl files.  You can build a clim.dxl by
-    loading <acl dir>/buildclim.cl.  It will create a clim.exe and
-    clim.dxl.  You can then run CLIM by executing clim.exe.
-
-    You can also build applications using generate-application and
-    putting the appropriate require's (of :climnt) in your sources.
-
-2.  Windows 95 is supported.
-
-3.  CLIM applications are about 10 megabytes smaller.
-
-4.  CLIM follows more of the Windows User Interface guidelines. This
-    includes windows that are LtGray, dialog boxes that are
-    application-modal, and menus that are "native."
-
-5.  select-file now uses the familiar windows dialog boxes via calls
-    to GetOpenFileName() and GetSaveFileName(). Use the keyword
-    :DIALOG-TYPE with a value of either :OPEN or :SAVE to control
-    which one you want.
-
-6.  notify-user now uses the familiar windows dialog boxes via calls
-    to MessageBox().
diff --git a/silica/graphics.lisp b/silica/graphics.lisp
index 448bac3f..de654da0 100644
--- a/silica/graphics.lisp
+++ b/silica/graphics.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: graphics.lisp,v 1.34 1998/08/06 23:16:59 layer Exp $
+;; $Id: graphics.lisp,v 1.35 1999/05/04 01:21:07 layer Exp $
 
 (in-package :silica)
 
@@ -306,22 +306,32 @@
 
 (defun map-endpoint-sequence (function positions)
   (declare (dynamic-extent function))
-  (if (listp positions)
-      (loop
-        (when (null positions) (return))
-        (let* ((x1 (pop positions))
-               (y1 (pop positions))
-               (x2 (pop positions))
-               (y2 (pop positions)))
-          (funcall function x1 y1 x2 y2)))
-      (let ((length (length positions))
-            #+Genera (positions positions))
-        (declare (type vector positions))
-        (do ((i 0 (+ i 4)))
-            ((>= i length))
-          (funcall function (aref positions i) (aref positions (1+ i))
-                            (aref positions (+ i 2)) (aref positions (+ i 3))))))
-  nil)
+  (let ((lastx nil) (lasty nil))
+    (cond ((listp positions)
+	   (setq lastx (pop positions))
+	   (setq lasty (pop positions))
+	   (loop
+	     (when (null positions) (return))
+	     (let* ((x (pop positions))
+		    (y (pop positions)))
+	       (funcall function lastx lasty x y)
+	       (setq lastx x lasty y))))
+	  (t
+	   (let ((length (length positions))
+		 (i 0))
+	     (declare (type vector positions) (fixnum i))
+	     (assert (evenp length))
+	     (setq lastx (aref positions i))
+	     (setq lasty (aref positions (1+ i)))
+	     (incf i 2)
+	     (loop 
+	       (when (>= i length) (return))
+	       (let* ((x (aref positions i))
+		      (y (aref positions (1+ i))))
+		 (funcall function lastx lasty x y)
+		 (setq lastx x lasty y)
+		 (incf i 2))))))
+    nil))
 
 ;; Transforms all of the positions in the sequence.  This returns the
 ;; original sequence if the transformation is the identity and COPY-P
diff --git a/sys/odrawpat.lisp b/sys/odrawpat.lisp
index 077795d4..22b5acd6 100644
--- a/sys/odrawpat.lisp
+++ b/sys/odrawpat.lisp
@@ -15,7 +15,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: odrawpat.lisp,v 1.2 1998/08/06 23:17:06 layer Exp $
+;; $Id: odrawpat.lisp,v 1.3 1999/05/04 01:21:07 layer Exp $
 
 (in-package :acl-clim)
 
@@ -63,29 +63,31 @@
 			  (nobutton nil)
 			  (label ""))
    (let* ((hwnd
-	   (CreateWindowEx
+	   (excl:with-native-string (classname "BUTTON")
+	     (excl:with-native-string (windowname (nstringify label))
+	       (CreateWindowEx
 		0			; extended-style
-		"BUTTON"		; classname
-		(nstringify label)	; windowname
+		classname		; classname
+		windowname		; windowname
 		(logior buttonstyle
-		    ;HBS_DOWNPICS	; special picture while pressed
-		    ;HBS_AUTOADVANCE
-		    ;HBS_TEXTINDENT
-			; (if (not active) win:bn_disable 0)
-		    (if (typep label 'acl-clim::acl-pixmap) win:bs_ownerdraw 0) 
-		    (if nobutton HBS_NOBUTTON 0)
-		    WS_CHILD
-		    WS_BORDER
-		    WS_CLIPCHILDREN 
-		    WS_CLIPSIBLINGS)	; style
+					;HBS_DOWNPICS	; special picture while pressed
+					;HBS_AUTOADVANCE
+					;HBS_TEXTINDENT
+					; (if (not active) win:bn_disable 0)
+			(if (typep label 'acl-clim::acl-pixmap) win:bs_ownerdraw 0) 
+			(if nobutton HBS_NOBUTTON 0)
+			WS_CHILD
+			WS_BORDER
+			WS_CLIPCHILDREN 
+			WS_CLIPSIBLINGS) ; style
 		0 0 0 0
 		parent
 		(let ((hmenu (ccallocate hmenu)))
 		  (setf (handle-value hmenu hmenu) id)
-		  ; (or id (next-child-id parent))
+					; (or id (next-child-id parent))
 		  hmenu)
 		*hinst*
-		"x")))
+		"x")))))
     (format *terminal-io* "~%use ownerdraw label ~S" label)
 
      (if (null-handle-p hwnd hwnd)
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 92e0ebe1..a6fa2c1f 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 -*-
 
-;; $Id: test-suite.lisp,v 1.85 1999/02/25 08:23:40 layer Exp $
+;; $Id: test-suite.lisp,v 1.86 1999/05/04 01:21:09 layer Exp $
 
 (in-package :clim-user)
 
@@ -668,6 +668,11 @@ people, shall not perish from the earth.
                 (sample (rest shape)))
             (format-graphics-sample stream label sample)))))))
 
+(defun rectangle-with-text (medium x1 y1 x2 y2 text &rest keys)
+  (apply #'draw-rectangle* medium x1 y1 x2 y2 keys)
+  (draw-line* medium x1 y1 x2 y2 :ink +flipping-ink+)
+  (draw-text* medium text x1 y1 :ink +flipping-ink+))
+
 (define-test (basic-graphics-inks graphics) (stream)
   "Test basic graphics inks"
   (formatting-graphics-samples (stream "Colors" 6)
@@ -691,7 +696,12 @@ people, shall not perish from the earth.
     (let ((sample '(draw-polygon* (0 0 45 100 100 0))))
       (dotimes (i 6)
         (format-graphics-sample stream (format nil "Ink ~D" i) sample
-                                :ink (make-contrasting-inks 6 i))))))
+                                :ink (make-contrasting-inks 6 i)))))
+  (formatting-graphics-samples (stream "Flipping" 10)
+    (let ((sample '(rectangle-with-text 0 0 200 100 "Flip")))
+      (format-graphics-sample stream "Black" sample :ink +black+)
+      (format-graphics-sample stream "White" sample :ink +white+)
+      (format-graphics-sample stream "Unfilled" sample :ink +black+ :filled nil))))
 
 (define-test (points-and-lines graphics) (stream)
   "Test drawing points"
diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp
index d0a778d0..9c894de5 100644
--- a/tk-silica/xt-graphics.lisp
+++ b/tk-silica/xt-graphics.lisp
@@ -15,7 +15,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: xt-graphics.lisp,v 1.98 1999/02/25 08:23:45 layer Exp $
+;; $Id: xt-graphics.lisp,v 1.99 1999/05/04 01:21:10 layer Exp $
 
 (in-package :tk-silica)
 
@@ -1646,11 +1646,16 @@
   (flet ((compute-rotation (x y towards-x towards-y)
 	   (decf towards-x x)
 	   (decf towards-y y)
-	   #+OLD ; ARE YOU KIDDING? THIS SURE IS THE LONG WAY AROUND THE BARN...JPM
+	   #+OLD			; ARE YOU KIDDING? THIS SURE IS THE LONG WAY AROUND THE BARN...JPM
 	   (MOD (ROUND (ATAN TOWARDS-Y TOWARDS-X) (/ PI 2.0)) 4)
-	   (IF (>= TOWARDS-X 0)
-	       (IF (>= TOWARDS-Y 0) 0 2)
-	     (IF (>= TOWARDS-Y 0) 1 3))))
+	   (cond ((> towards-x 0)
+		  (cond ((> towards-y 0) 1)
+			((= towards-y 0) 0)
+			(t 3)))
+		 ((= towards-x 0)
+		  (cond ((>= towards-y 0) 1)
+			(t 3)))
+		 (t 2))))
     (let* ((rotation (compute-rotation x y towards-x towards-y))
 	   (min-char (xt::font-range font))
 	   (ascent (xt::font-ascent font))
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index eab4edf2..8a270c30 100644
--- a/tk-silica/xt-silica.lisp
+++ b/tk-silica/xt-silica.lisp
@@ -15,7 +15,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: xt-silica.lisp,v 1.111 1999/02/25 08:23:46 layer Exp $
+;; $Id: xt-silica.lisp,v 1.112 1999/05/04 01:21:10 layer Exp $
 
 (in-package :xm-silica)
 
@@ -1332,20 +1332,21 @@
 			     (char-int #\A)
 			   (char-int #\a)))))
 	       character))
-	  ;; I believe this use of character bit attributes
-	  ;; is unnecessary because all that information is 
-	  ;; in the keysym.  JPM 1/13/99.
-	  #+ignore
 	  (setq character 
-	    (cltl1:make-char
+	    (clim-make-char
 	     character
 	     (logior
 	      (if (logtest x +control-key+) 1 0)
 	      (if (logtest x +meta-key+)    2 0)
-	      (if (logtest x +super-key+)	  4 0)
-	      (if (logtest x +hyper-key+)	  8 0))))))
+	      (if (logtest x +super-key+)   4 0)
+	      (if (logtest x +hyper-key+)   8 0))))))
       (values character (xt-keysym->keysym keysym)))))
 
+(defun clim-make-char (character &optional (bits 0))
+  ;; Like cltl1:make-char but prevents the need to (require :cltl1)
+  (if (zerop bits)
+      character
+    (code-char (char-code character) bits)))
 
 (defun state->modifiers (x)
   (declare (optimize (speed 3) (safety 0))
diff --git a/utils/defun-utilities.lisp b/utils/defun-utilities.lisp
index 856c3f68..83b10fb7 100644
--- a/utils/defun-utilities.lisp
+++ b/utils/defun-utilities.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: defun-utilities.lisp,v 1.15 1999/02/25 08:23:46 layer Exp $
+;; $Id: defun-utilities.lisp,v 1.16 1999/05/04 01:21:12 layer Exp $
 
 (in-package :clim-utils)
 
@@ -117,3 +117,28 @@
   (pushnew 'defun-inline zwei:*irrelevant-functions*)
   (pushnew 'defun-inline zwei:*irrelevant-defining-forms*))
 
+;;
+;; Backwards compatibility for new ics functions during beta2 development
+;;
+#+allegro
+(in-package :excl)
+#+allegro
+(progn
+  #-(version>= 5 (0 1) :pre-beta2 7)
+  (defmacro with-native-string ((native-string-var string-exp)
+				&body body)
+    `(let ((,native-string-var ,string-exp))
+       ,@body))
+
+  #-(version>= 5 (0 1) :pre-beta2 7)
+  (eval-when (compile load eval) (export 'with-native-string))
+
+  #-(version>= 5 (0 1) :pre-beta2 7)
+  (defun mb-to-string (mb-vector)
+    (let* ((lgth (1- (length mb-vector)))
+	   (string (make-string lgth)))
+      (dotimes (i lgth string)
+	(setf (schar string i) (aref mb-vector i)))))
+
+  #-(version>= 5 (0 1) :pre-beta2 7)
+  (eval-when (compile load eval) (export 'mb-to-string)))
diff --git a/utils/designs.lisp b/utils/designs.lisp
index 670d1aed..47254aeb 100644
--- a/utils/designs.lisp
+++ b/utils/designs.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: designs.lisp,v 1.25 1998/08/06 23:17:33 layer Exp $
+;; $Id: designs.lisp,v 1.26 1999/05/04 01:21:12 layer Exp $
 
 (in-package :clim-utils)
 
@@ -330,13 +330,32 @@
 
 ;;; Palettes
 
+;;; Portability note: It is not possible to get a palette-full
+;;; error on #+mswindows.  The operating system will automatically
+;;; give you the closest matching color.  JPM 2/24/99.
+
+(defparameter *palette-full-error-message*
+    "The color palette is full. ~%~
+Try closing color-intensive applications such as Netscape, or try~%~
+setting the colormap X resource to yes to get a private colormap,~%~
+then restart your application.")
+
+(defparameter *palette-full-dynamic-error-message*
+    "The color palette is full ~%~
+and find-closest-matching-color does not apply to dynamic colors.~%~
+Try closing color-intensive applications such as Netscape, or try~%~
+setting the colormap X resource to yes to get a private colormap,~%~
+then restart your application.")
+
 (eval-when (#-Allegro compile load eval)
 (define-condition palette-full (error)
   ((palette :initarg :palette :reader palette-full-palette)
    (color :initarg :color :reader palette-full-color))
   (:report (lambda (condition stream)
-	     (format stream "The palette ~S is full"
-	       (palette-full-palette condition)))))
+	     (let ((color (palette-full-color condition)))
+	       (if (typep color 'dynamic-color)
+		   (format stream *palette-full-dynamic-error-message*)
+		 (format stream *palette-full-error-message*))))))
 )	;eval-when
 
 (defvar *use-closest-color* :warn)
diff --git a/utils/packages.lisp b/utils/packages.lisp
index 04c1e5ad..00170549 100644
--- a/utils/packages.lisp
+++ b/utils/packages.lisp
@@ -16,7 +16,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: packages.lisp,v 1.90 1999/02/25 08:23:46 layer Exp $
+;; $Id: packages.lisp,v 1.91 1999/05/04 01:21:12 layer Exp $
 
 (in-package :common-lisp-user)
 
@@ -3289,7 +3289,7 @@
 (cl:defvar *clim-major-version* 2)
 (cl:defvar *clim-minor-version* 2)
 (cl:defvar *clim-generation-version* 2)
-(cl:defvar *clim-build-version* 5)
+(cl:defvar *clim-build-version* 6)
 
 (cl:defparameter *clim-version*
     (cl:format () "~d.~d.~d.~a"
-- 
GitLab