diff --git a/ChangeLog.n b/ChangeLog.n
index 38a6f69278d70427a2f91ffa2b02f4076b6aaac6..c8e7db73e66c307e03f9520f99e72b434aa75c3c 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -1,3 +1,19 @@
+2007-04-24  Andreas Fuchs  <asf@boinkor.net>
+	   
+	* aclpc/acl-class.lisp, aclpc/acl-port.lisp:
+	  * Refactor most ACL port-specific special variables to be
+            slots of the acl-port instance.
+	  * Change reset-aclpc-clim to only destroy the port and reset
+            the few remaining special variables
+	* aclpc/acl-dc: Refer to the slots of *acl-port*.
+	* aclpc/acl-frames.lisp: Refer to the slots of *acl-port*.
+	* aclpc/acl-medium.lisp: Refer to the slots of *acl-port*.
+	* aclpc/acl-mirror.lisp: Refer to the slots of *acl-port*.
+	* aclpc/acl-prel.lisp: Refer to the slots of *acl-port*.
+	* aclpc/acl-scroll.lisp: Refer to the slots of *acl-port*.
+	* aclpc/acl-widget.lisp: Refer to the slots of *acl-port*.
+	* sys/odrawpat.lisp: Refer to the slots of *acl-port*.
+
 *******************************************************************************
 join from trunk_afuchs2 to trunk
     changes from:
@@ -6155,4 +6171,4 @@ IGNORE JDI SPECIFIC CHANGES TO Makefile
 	Lots of other stuff
 
 *******************************************************************************
-$Revision: 2.32 $
+$Revision: 2.33 $
diff --git a/aclpc/acl-class.lisp b/aclpc/acl-class.lisp
index d3d4d6a13b04cd766a586f6360be4cafb115ac95..969b514975a12da49e16dbec68c4a7ec3fc2217a 100644
--- a/aclpc/acl-class.lisp
+++ b/aclpc/acl-class.lisp
@@ -17,7 +17,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 2.18 2007/04/17 21:45:48 layer Exp $
+;; $Id: acl-class.lisp,v 2.19 2007/04/25 20:29:26 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -32,15 +32,6 @@
 
 (defvar *acl-port* nil)
 
-;; this will grow indefinitely as menu-ids are never removed (cim 9/10/96)
-(defvar *menu-id->command-table*
-    (make-array 256 
-		:element-type t :adjustable t 
-		:fill-pointer 0 :initial-element nil))
-
-;; this will grow indefinitely as items are never removed (cim 9/10/96)
-(defvar *popup-menu->menu-item-ids* (make-hash-table))
-
 ;; this will grow indefinitely as items are never removed (cim 9/10/96)
 (defvar *popup-menu->command-table* (make-hash-table))
 
@@ -55,19 +46,10 @@
 (defun mformat (&rest args)
   (if *maybe-format* (apply #'format args)))
 
-(defvar *msg-names* nil)
-
-(defun init-msg-names ()
-  (setq *msg-names* (make-array 4096))
-  (dolist (x (remove-duplicates
-	      (apropos-list "WM_" (find-package :win))))
-    (when (<= 0 (symbol-value x) 4095)
-      (push x (svref *msg-names* (symbol-value x))))))
 
 (defun msg-name (msg)
-  (unless *msg-names* (init-msg-names))
   (let ((x (and (< msg 4096) ;; pr Aug97
-		(svref *msg-names* msg))))
+		(svref (msg-names *acl-port*) msg))))
     (unless (cdr x)
       (setq x (car x)))
     (or x msg)))
@@ -89,27 +71,18 @@
         (make-modifier-state :meta)
         (make-modifier-state)))))
 
-(defvar *modstate* (make-modstate))
-(defvar *ctlmodstate* (make-modstate))
-(defvar *win-result* 0)
-
-(defparameter arrow-cursor 
-    (ff:allocate-fobject 'win:hcursor :foreign-static-gc nil))
-(defparameter application-icon 
-    (ff:allocate-fobject 'win:hicon  :foreign-static-gc nil))
-
 ;;;;; window procedure args, rebound in each call to window proc
 ;;;(defvar *hwnd* 0)
 
 (defun init-cursors ()
   ;; put back old cursor mechanism for the moment (cim 9/13/96)
-  (setf arrow-cursor (win:LoadCursor 0 win:IDC_ARROW))
-  (when (zerop arrow-cursor)
+  (setf (arrow-cursor *acl-port*) (win:LoadCursor 0 win:IDC_ARROW))
+  (when (zerop (arrow-cursor *acl-port*))
     (check-last-error "LoadCursor" :action :warn))
   ;; this just does the icon now - the cursor stuff is all handled in
   ;; realize-cursor methods in acl-port (cim 9/12/96)
-  (setf application-icon (win:LoadIcon 0 win:IDI_APPLICATION))
-  (when (zerop application-icon)
+  (setf (application-icon *acl-port*) (win:LoadIcon 0 win:IDI_APPLICATION))
+  (when (zerop (application-icon *acl-port*))
     (check-last-error "LoadIcon" :action :warn))
   t)
 
@@ -170,16 +143,6 @@
 
 (defvar *level* 0)
 
-(defvar *realtime-scrollbar-tracking* t)
-
-(defvar *win-scroll-grain* 
-    ;; Must be a 16-bit quantity.
-    ;; According to Microsoft, WM_HSCROLL and WM_VSCROLL messages
-    ;; are "limited to 16 bits of position data".
-    ;; (alemmens, 2004-12-17)
-    (1- (expt 2 16)))
-
-
 (defmacro clear-winproc-result (res)
   (declare (ignore res))
   nil)
@@ -199,7 +162,7 @@
 	(keys wparam)
 	(sheet (mirror->sheet *acl-port* window)))
     (declare (ignore keys))
-    (setq *win-result*
+    (setf (win-result *acl-port*)
       (if (or (not sheet) 
 	      (note-pointer-motion *acl-port* sheet mx my))
 	  (win:DefWindowProc window msg wparam lparam)
@@ -211,7 +174,7 @@
   ;; when the cursor is not moving.  JPM 5/98.
   (let* ((hit-code (loword lparam)))
     (cond ((eql hit-code win:HTCLIENT)
-	   (setq *win-result* 
+	   (setf (win-result *acl-port*) 
 	     (if (maybe-set-cursor (mirror->sheet *acl-port* window))
 		 win:TRUE win:FALSE)))
 	  (t 
@@ -294,7 +257,7 @@
 	     (win:GetClientRect hwnd rect)
 	     (silica::draw-picture-button sheet 0 hdc rect)))
 	 
-	 (setf *win-result* (adjust-gadget-colors sheet hdc))))))
+	 (setf (win-result *acl-port*) (adjust-gadget-colors sheet hdc))))))
 
 ;; Process WM_COMMAND.
 ;; This message is sent when the user selects a command item
@@ -311,7 +274,7 @@
 	   ;; User selected a command from the menu bar.
 	   (let* ((frame (pane-frame parent))
 		  (ID (loword wparam))
-		  (command (cdr (aref *menu-id->command-table* ID))))
+		  (command (cdr (aref (menu-id->command-table port) ID))))
 	     
 	     ;;mm bug12977
 	     (handler-case
@@ -334,7 +297,7 @@
 	   (let ((gadget (mirror->sheet port lparam)))
 	     (when gadget
 	       (command-event gadget port parent wparam lparam)))))
-    (clear-winproc-result *win-result*)
+    (clear-winproc-result (win-result *acl-port*))
         0))
 
 
@@ -418,8 +381,8 @@
         (case scrollcode
           (#.win:SB_BOTTOM
            ;; Scroll to lower right
-           (win:SetScrollPos hwnd bar *win-scroll-grain* redraw)
-           (values :percentage *win-scroll-grain*))
+           (win:SetScrollPos hwnd bar (win-scroll-grain *acl-port*) redraw)
+           (values :percentage (win-scroll-grain *acl-port*)))
           ((#.win:SB_LINEDOWN #.win:SB_LINERIGHT)
            ;; Scroll down/right one line
            (move-slug sheet hwnd bar +1 #'silica::scroll-bar-line-increment)
@@ -461,8 +424,8 @@
                                         :dragging-p (= scrollcode #.win:SB_THUMBTRACK)
                                         :amount amount
                                         :sheet sheet)))))
-    (clear-winproc-result *win-result*)
-    *win-result*))
+    (clear-winproc-result (win-result *acl-port*))
+    (win-result *acl-port*)))
 
 (defun move-slug (scroll-bar hwnd win-code direction delta-function)
   ;; Only move slug for independent scroll bar gadgets.
@@ -474,7 +437,7 @@
            (tentative-new-position 
             (+ old-position
               (* direction (silica::convert-scroll-bar-size-out scroll-bar delta))))
-           (new-position (max 0 (min *win-scroll-grain* tentative-new-position)))
+           (new-position (max 0 (min (win-scroll-grain *acl-port*) tentative-new-position)))
            (redraw 1))
       (unless (= old-position new-position)
         (win:SetScrollPos hwnd win-code new-position redraw)))))
@@ -496,9 +459,9 @@
 	   sheet
 	   (allocate-event 'window-configuration-event :sheet sheet))
 	  ;; set return value to 0
-	  (clear-winproc-result *win-result*))
-      (setq *win-result* (win:DefWindowProc window msg wparam lparam)))
-    *win-result*))
+	  (clear-winproc-result (win-result *acl-port*)))
+      (setf (win-result *acl-port*) (win:DefWindowProc window msg wparam lparam)))
+    (win-result *acl-port*)))
 
 ;; Process WM_SIZE
 (defun onsize (window msg wparam lparam)
@@ -511,9 +474,9 @@
 	   sheet
 	   (allocate-event 'window-configuration-event :sheet sheet))
 	  ;; set return value to 0
-	  (clear-winproc-result *win-result*))
-      (setq *win-result* (win:DefWindowProc window msg wparam lparam)))
-    *win-result*))
+	  (clear-winproc-result (win-result *acl-port*)))
+      (setf (win-result *acl-port*) (win:DefWindowProc window msg wparam lparam)))
+    (win-result *acl-port*)))
 
 ;; Process WM_GETMINMAXINFO
 (defun ongetminmaxinfo (window msg wparam lparam)
@@ -526,9 +489,9 @@
 	  (when (and min-width min-height)
 	    (setf (sys:memref-int lparam 0 24 :unsigned-long) min-width
 		  (sys:memref-int lparam 0 28 :unsigned-long) min-height)
-	    (clear-winproc-result *win-result*)))
-      (setq *win-result* (win:DefWindowProc window msg wparam lparam)))
-    *win-result*))
+	    (clear-winproc-result (win-result *acl-port*))))
+      (setf (win-result *acl-port*) (win:DefWindowProc window msg wparam lparam)))
+    (win-result *acl-port*)))
 
 ;; PROCESS EN_UPDATE
 (defun onupdatetext (window msg wparam lparam)
@@ -543,12 +506,12 @@
 	;; sheet
 	;;  (allocate-event 'window-change-event :sheet sheet)
 	))
-    (clear-winproc-result *win-result*)
-    *win-result*))
+    (clear-winproc-result (win-result *acl-port*))
+    (win-result *acl-port*)))
 
 ;; Process WM_KEYDOWN
 ;;; SPR25900 --pnc
-;;; The variable *modstate* is used to specify the alt/meta
+;;; The port slot modstate is used to specify the alt/meta
 ;;; key on mouse-gestures.  See the functions onbuttondown
 ;;; and windows-mask->modifier-state+ (in aclpc/acl-port.lisp).
 (defun onkeydown (window msg wparam lparam)
@@ -567,14 +530,14 @@
 	   (shiftstate (win:GetKeyState win:VK_SHIFT))
 	   (controlstate (win:GetKeyState win:VK_CONTROL))
 	   (metastate (win:GetKeyState win:VK_MENU)))
-      (setf (modstate-control *modstate*)
+      (setf (modstate-control (modstate *acl-port*))
 	(or (minusp controlstate) (not (zerop (ash controlstate -15)))))
-      (setf (modstate-meta *modstate*)
+      (setf (modstate-meta (modstate *acl-port*))
 	;; whoops! this was controlstate!?
 	(or (minusp metastate) (not (zerop (ash metastate -15)))))
-      (setf (modstate-numlock *modstate*)
+      (setf (modstate-numlock (modstate *acl-port*))
 	(and (plusp numstate) (zerop (ash numstate -15))))
-      (setf (modstate-shift *modstate*)
+      (setf (modstate-shift (modstate *acl-port*))
 	(or (and (or (minusp shiftstate) 
 		     (not (zerop (ash shiftstate -15))))
 		 (zerop capstate))
@@ -584,27 +547,27 @@
     (if pass
 	(progn
 	  (setq pass nil)
-	  (setq *win-result* (win:DefWindowProc window msg wparam lparam))
+	  (setf (win-result *acl-port*) (win:DefWindowProc window msg wparam lparam))
 	  ;;added this so that port modifier state is always updated, 
 	  ;; even on passed characters. -- KR
 	  (setf (port-modifier-state *acl-port*)
-	    (modstate->modifier *modstate*))
-	  *win-result*)
+	    (modstate->modifier (modstate *acl-port*)))
+	  (win-result *acl-port*))
       (progn
 	(when (and (or (<= #x30 vk #x5a)
 		       (<= #xba vk #xc0)
 		       (<= #xdb vk #xdf))
-		   (modstate-shift *modstate*))
+		   (modstate-shift (modstate *acl-port*)))
 	  (setf code (logior #x100 code)))
 	;; NUM LOCK
 	(when (and (<= #x60 vk #x69)
-		   (not (modstate-numlock *modstate*)))
+		   (not (modstate-numlock (modstate *acl-port*))))
 	  (setf code (logior #x100 code)))
 	(with-slots (event-queue vk->keysym) *acl-port*
 	  (let ((keysym (or (gethash (ldb (byte 9 0) code) vk->keysym)
 			    (gethash (ldb (byte 8 0) code) vk->keysym)))
 		(char nil)
-		(modstate (modstate->modifier *modstate*))
+		(modstate (modstate->modifier (modstate *acl-port*)))
 		(sheet (mirror->sheet *acl-port* window)))
 	    (when (consp keysym)
 	      (setf keysym (first keysym)))
@@ -641,11 +604,11 @@
 		     ;;added this so that port modifier state is always 
 		     ;; updated, even on passed characters. -- KR
 		     (setf (port-modifier-state *acl-port*)
-		       (modstate->modifier *modstate*))
+		       (modstate->modifier (modstate *acl-port*)))
 		     )))))
 	;; set return value to 0
-	(clear-winproc-result *win-result*)
-	*win-result*))))
+	(clear-winproc-result (win-result *acl-port*))
+	(win-result *acl-port*)))))
 
 (defun find-default-gadget (frame)
   ;; Look for a button that is "show-as-default"
@@ -728,8 +691,8 @@
 				     :modifier-state modifier-state
 				     :pointer pointer
 				     :sheet sheet))))))
-  (clear-winproc-result *win-result*)
-  *win-result*)
+  (clear-winproc-result (win-result *acl-port*))
+  (win-result *acl-port*))
 
 ;; Process WM_LBUTTONDBLCLK
 (defun onbuttondblclk (window msg wparam lparam)
@@ -764,8 +727,8 @@
 				     :modifier-state modifier-state
 				     :pointer pointer
 				     :sheet sheet))))))
-  (clear-winproc-result *win-result*)
-  *win-result*)
+  (clear-winproc-result (win-result *acl-port*))
+  (win-result *acl-port*))
 
 ;; Process WM_ACTIVATE
 (defun onactivate (window msg wparam lparam)
@@ -780,7 +743,7 @@
 	(active (loword wparam)))
     (when (and sheet (not (= active WA_INACTIVE)))
       (setf (acl-port-mirror-with-focus *acl-port*) window))
-    (setq *win-result* (win:DefWindowProc window msg wparam lparam))))  
+    (setf (win-result *acl-port*) (win:DefWindowProc window msg wparam lparam))))  
 
 ;; Process WM_KILLFOCUS
 (defun onkillfocus (window msg wparam lparam)
@@ -798,8 +761,8 @@
 			(allocate-event 'silica::window-close-event
 					:sheet sheet)))))
     ;; set return value to 0
-    (clear-winproc-result *win-result*)
-    *win-result*))
+    (clear-winproc-result (win-result *acl-port*))
+    (win-result *acl-port*)))
 
 ;; Process WM_INITMENUPOPUP
 (defun oninitmenupopup (window msg wparam lparam)
@@ -815,23 +778,20 @@
       (update-menu-contents sheet menu-handle index)
       (update-menu-item-sensitivities menu-handle)
       ;; set return value to 0
-      (clear-winproc-result *win-result*)
-      *win-result*)))
+      (clear-winproc-result (win-result *acl-port*))
+      (win-result *acl-port*))))
 
 ;; Process WM_NCHITTEST
 (defun onnchittest (window msg wparam lparam)
   ;; Called on the object that contains the cursor
   ;; every time the mouse moves.
-  (setq *win-result* (win:DefWindowProc window msg wparam lparam)))
+  (setf (win-result *acl-port*) (win:DefWindowProc window msg wparam lparam)))
 
 ;; Allow Windows to provide default message processing.
 (defun message-default (window msg wparam lparam)
-  (clear-winproc-result *win-result*)
-  (setq *win-result* (win:DefWindowProc window msg wparam lparam))
-  *win-result*)
-
-(defvar wres  (ct:callocate :long))
-(defvar wmsg  (ct:ccallocate win:msg))
+  (clear-winproc-result (win-result *acl-port*))
+  (setf (win-result *acl-port*) (win:DefWindowProc window msg wparam lparam))
+  (win-result *acl-port*))
 
 ;; Refer to the windows documentation on Tooltip controls.
 ;; The message stream needs to be relayed to the tooltip 
@@ -854,7 +814,7 @@
 	    (top (frame-top-level-sheet frame))
 	    (tt (tooltip-control top))
 	    (ttm_relayevent #.(+ win:WM_USER 7))
-	    (relay wmsg))
+	    (relay (wmsg *acl-port*)))
        (when tt
 	 (ct:csets win:msg relay
 		   lparam lparam
@@ -864,7 +824,7 @@
 	 (or (plusp (win:SendMessage tt ttm_relayevent 0 relay))
 	     (check-last-error "TTM_RELAYEVENT" :Action :warn))))))
   #+optional
-  (callnexthookex *next-windows-hook* msg wparam lparam))
+  (callnexthookex (next-windows-hook *acl-port*) msg wparam lparam))
 
 ;;; Windows messages get printed to the value of this, if
 ;;; *maybe-format* is non-NIL
@@ -965,7 +925,7 @@
        (message-default window msg wparam lparam))
       (otherwise
        (message-default window msg wparam lparam)))
-    (setf result *win-result*)
+    (setf result (win-result *acl-port*))
     (mformat *windows-message-trace-output*
 	     "~A Out clim-wind-proc msg=~a sheet=~s result=~s~%"
 	       *level*
@@ -1010,7 +970,6 @@
 (ff:defun-foreign-callable clim-ctrl-proc (window msg wparam lparam)
   (declare (:convention :stdcall) (:unwind 0))
   (mp:without-scheduling
-    (setf *hwnd* window)
     (let ((result 0)
           (sheet (mirror->sheet *acl-port* window)))
       (mformat excl:*initial-terminal-io*
@@ -1045,13 +1004,13 @@
 		 (shiftstate (win:GetKeyState win:VK_SHIFT))
 		 (controlstate (win:GetKeyState win:VK_CONTROL))
 		 (metastate (win:GetKeyState win:VK_MENU)))
-	    (setf (modstate-control *ctlmodstate*)
+	    (setf (modstate-control (ctlmodstate *acl-port*))
 	      (or (minusp controlstate) (not (zerop (ash controlstate -15)))))
-	    (setf (modstate-meta *ctlmodstate*)
+	    (setf (modstate-meta (ctlmodstate *acl-port*))
 	      (or (minusp metastate) (not (zerop (ash metastate -15)))))
-	    (setf (modstate-numlock *ctlmodstate*)
+	    (setf (modstate-numlock (ctlmodstate *acl-port*))
 	      (and (plusp numstate) (zerop (ash numstate -15))))
-	    (setf (modstate-shift *ctlmodstate*)
+	    (setf (modstate-shift (ctlmodstate *acl-port*))
 	      (or (and (or (minusp shiftstate) 
 			   (not (zerop (ash shiftstate -15))))
 		       (zerop capstate))
@@ -1060,17 +1019,17 @@
 		       (and (plusp capstate) (zerop (ash capstate -15)))))))
 
 	  (when (and (or (<= #x30 vk #x5a)(<= #xba vk #xc0)(<= #xdb vk #xdf))
-		     (modstate-shift *ctlmodstate*))
+		     (modstate-shift (ctlmodstate *acl-port*)))
 	    (setf code (logior #x100 code)))
 	  ;; NUM LOCK
 	  (when (and (<= #x60 vk #x69)
-		     (not (modstate-numlock *ctlmodstate*)))
+		     (not (modstate-numlock (ctlmodstate *acl-port*))))
 	    (setf code (logior #x100 code)))
 	  (with-slots (event-queue vk->keysym) *acl-port*
 	    (let ((keysym (or (gethash (ldb (byte 9 0) code) vk->keysym)
 			      (gethash (ldb (byte 8 0) code) vk->keysym)))
 		  (char nil)
-		  (modstate (modstate->modifier *ctlmodstate*))
+		  (modstate (modstate->modifier (ctlmodstate *acl-port*)))
 		  ;;(sheet (mirror->sheet *acl-port* window))
 		  )
 	      (when (consp keysym)
@@ -1086,17 +1045,18 @@
                 ;;mm: spr27890 look at :newline or :tab ourselves
                 (case keysym 
                   (:newline (eql modstate 0))
-                  (:tab (or (eql modstate 0) (modstate-shift *ctlmodstate*)))))
+                  (:tab (or (eql modstate 0) (modstate-shift (ctlmodstate
+							      *acl-port*))))))
            (setq pass nil)) ;;; Don't pass along the character.
        (if pass
            (progn
              (setq pass nil)
              (setq 
-              ;;mm *win-result* 
+              ;;mm (win-result *acl-port*) 
               result
-               (win:CallWindowProc std-ctrl-proc-address
+               (win:CallWindowProc (std-ctrl-proc-address *acl-port*)
                                    window msg wparam lparam))
-             *win-result*)
+             (win-result *acl-port*))
          (let ((sheet (mirror->sheet *acl-port* window)))
            ;; We have decided to handle this character ourselves!
            
@@ -1121,7 +1081,7 @@
                   :sheet sheet))) sheet)
 
 		  ;; set return value to 0
-		  ;;(clear-winproc-result *win-result*)
+		  ;;(clear-winproc-result (win-result *acl-port*))
 		  (setq result 0)))))))
 
        ;; 17-Mar-03  mm [bug13094]      
@@ -1133,38 +1093,22 @@
 	;; it seems to be coming because of the IsDialogMessage call.
 	;; We return 0 to pervent special (dialog accelerator) handling
 	;; for any of the keys that should be translated to WM_CHAR messages.
-	(clear-winproc-result *win-result*) 
-	(setf *win-result* 0)
-	*win-result*)
+	(clear-winproc-result (win-result *acl-port*)) 
+	(setf (win-result *acl-port*) 0)
+	(win-result *acl-port*))
 
        (t
 	;; This is where we let the control do its own thing.  Most
 	;; messages come through here.
-	;;(clear-winproc-result *win-result*)
-	(setq ;;*win-result*
+	;;(clear-winproc-result (win-result *acl-port*))
+	(setq ;;(win-result *acl-port*)
 	 result
-	 (win:CallWindowProc std-ctrl-proc-address
+	 (win:CallWindowProc (std-ctrl-proc-address *acl-port*)
 					       window msg wparam lparam))
-        *win-result*))
-      ;;(setf result *win-result*)
+        (win-result *acl-port*)))
+      ;;(setf result (win-result *acl-port*))
       result)))
 
-(defvar *clim-class* "ClimClass")
-(defvar *win-name* "CLIM")
-(defvar *menu-name* "ClimMenu")
-(defvar *win-x* "x")
-(defvar *wndclass-registered* nil)
-(defvar clim-window-proc-address nil)
-(defvar clim-ctrl-proc-address nil)
-(defvar std-ctrl-proc-address nil)
-(defvar tooltip-relay-address nil)
-(defvar *next-windows-hook* nil)
-(defvar *clim-initialized* nil)
-(defvar lpcmdline "")
-(defvar *hinst* 0) 
-(defvar *hprevinst* 0) 
-(defvar *screen-device* nil)
-
 
 (defun initialize-clim (&optional (mp t))
   (declare (ignore mp))
@@ -1186,11 +1130,10 @@
 	   4 ;; make sure this stays in sync with cl/src/c/dllmain.c
 	   :element-type 'signed-nat)))
     (win:GetWinMainArgs dataobj)
-    (setq *hinst*      (aref dataobj 0)
-	  *hprevinst*  (aref dataobj 1)
-	  lpcmdline    (aref dataobj 2)))
-  (setq *screen-device*
-    (make-instance 'windows-screen-device)))
+    (setf (hinst *acl-port*)         (aref dataobj 0)
+	  ;;(hprevinst *acl-port*)   (aref dataobj 1)
+	  (lpcmdline *acl-port*)     (aref dataobj 2)
+	  (screen-device *acl-port*) (make-instance 'windows-screen-device))))
 
 (defun make-cstructure (type length)
   ;; create and return a region of memory of the
@@ -1198,23 +1141,37 @@
   (declare (ignore type))
   (ff:allocate-fobject `(:array :unsigned-char ,length) :foreign-static-gc))
 
-(defun ensure-clim-initialized ()
-  (unless *clim-initialized*
+(defun ensure-clim-initialized (*acl-port*)
+  (unless (acl-clim-initialized-p *acl-port*)
     (initialize-cg)
-    (setf clim-window-proc-address 
-      (init-clim-win-proc clim-window-proc-address (make-cstructure 0 16)))
-    (setf clim-ctrl-proc-address 
-      (init-clim-ctrl-proc clim-ctrl-proc-address (make-cstructure 0 16)))
+    (setf (clim-window-proc-address *acl-port*) 
+	  (init-clim-win-proc (if (slot-boundp *acl-port*
+					       'clim-window-proc-address)
+				  (clim-window-proc-address *acl-port*)
+				  nil)
+			      (make-cstructure 0 16)))
+    (setf (clim-ctrl-proc-address *acl-port*) 
+	  (init-clim-ctrl-proc (if (slot-boundp *acl-port*
+						'clim-ctrl-proc-address)
+				   (clim-ctrl-proc-address *acl-port*)
+				   nil)
+			       (make-cstructure 0 16)))
     #+not-yet
-    (setf tooltip-relay-address 
-      (init-tooltip-relay tooltip-relay-address (make-cstructure 0 16)))
-    (setq *clim-initialized* t)))
+    (setf (tooltip-relay-address *acl-port*) 
+	  (init-tooltip-relay
+	   (if (slot-boundp *acl-port*
+			    'tooltip-relay-address)
+	       (tooltip-relay-address *acl-port*)
+	       nil)
+	   (make-cstructure 0 16)))
+    (setf (clim-initialized-p *acl-port*) t)))
 
 (defun acl-clim::register-window-class (hcursor)
   ;; This is called by initialize-instance of acl-port.
   ;; It creates a (single) Windows window class for all clim windows.
-  (unless *wndclass-registered*
-    (init-clim-win-proc clim-window-proc-address (make-cstructure 0 16))
+  (unless (wndclass-registered *acl-port*)
+    (init-clim-win-proc (clim-window-proc-address *acl-port*)
+			(make-cstructure 0 16))
     (let ((class (ff:allocate-fobject 'win:wndclassex 
 				      :foreign-static-gc nil))
 	  (icon (win:LoadIcon 0 win:IDI_APPLICATION)) ; (get-clim-icon)
@@ -1229,7 +1186,7 @@
 		win:CS_BYTEALIGNWINDOW))
       (setf (ff:fslot-value-typed 'win:wndclassex 
 				  :foreign class :lpfnWndProc)
-	clim-window-proc-address)
+	    (clim-window-proc-address *acl-port*))
       (setf (ff:fslot-value-typed 'win:wndclassex 
 				  :foreign class :cbClsExtra) 
 	0)
@@ -1238,7 +1195,7 @@
 	0)
       (setf (ff:fslot-value-typed 'win:wndclassex 
 				  :foreign class :hInstance) 
-	*hinst*)
+	(hinst *acl-port*))
       (setf (ff:fslot-value-typed 'win:wndclassex 
 				  :foreign class :hIcon) 
 	icon)
@@ -1253,7 +1210,7 @@
 	0)
       (setf (ff:fslot-value-typed 'win:wndclassex 
 				  :foreign class :lpszClassName) 
-	(string-to-foreign *clim-class*))
+	(string-to-foreign (acl-clim::clim-class *acl-port*)))
 	  
       (setf (ff:fslot-value-typed 'win:wndclassex 
 				  :foreign class :hIconSm) 
@@ -1261,13 +1218,13 @@
       (setq reg (win:RegisterClassEx class))
       (when (zerop reg)
 	(check-last-error "RegisterClassEx"))
-      (setq *wndclass-registered* t)
-      (when tooltip-relay-address
-	(setq *next-windows-hook*
+      (setf (wndclass-registered *acl-port*) t)
+      (when (tooltip-relay-address *acl-port*)
+	(setf (next-windows-hook *acl-port*)
 	  (SetWindowsHookEx win:WH_GETMESSAGE 
-			    tooltip-relay-address
+			    (tooltip-relay-address *acl-port*)
 			    0 0))
-	(when (zerop *next-windows-hook*)
+	(when (zerop (next-windows-hook *acl-port*))
 	  (check-last-error "SetWindowsHookEx")))
       t)))
 
@@ -1300,12 +1257,12 @@
 	  win:WS_EX_WINDOWEDGE
 	  win:WS_EX_CONTROLPARENT	; TAB BTWN CONTROLS
 	  ))
-        (*win-name* *win-name*)
+        (win-name (acl-clim::win-name *acl-port*))
 	(menu
 	 (if menubar (win:CreateMenu) 0))
 	(window nil))
     (when pretty
-      (setq *win-name* pretty))
+      (setq win-name pretty))
     (cond (modal
 	   ;; Accepting-values comes in here.  We need
 	   ;; thickframe, even though that is not normally
@@ -1329,17 +1286,17 @@
 		     win:WS_MINIMIZEBOX
 		     win:WS_MAXIMIZEBOX))))
     (setq window
-      (excl:with-native-string (*clim-class* *clim-class*)
-	(excl:with-native-string (*win-name* *win-name*)
+      (excl:with-native-string (clim-class (acl-clim::clim-class *acl-port*))
+	(excl:with-native-string (win-name win-name)
 	  (win:CreateWindowEx exstyle
-			      *clim-class*
-			      *win-name*
+			      clim-class
+			      win-name
 			      winstyle
 			      left top width height
 			      (or parent 0)
 			      menu
-			      *hinst*
-			      *win-x* )))) 
+			      (hinst *acl-port*)
+			      (win-x *acl-port*) )))) 
     (when (zerop window)
       (or (check-last-error "CreateWindowEx")
 	  (error "CreateWindowEx: unknown error")))
@@ -1361,22 +1318,22 @@
 			       win:WS_HSCROLL 0)
 			   win:WS_CLIPCHILDREN
 			   ))
-         (*win-name* *win-name*))
+         (win-name (acl-clim::win-name *acl-port*)))
     (when pretty
-      (setq *win-name* pretty))
+      (setq win-name pretty))
     (let ((window
-	   (excl:with-native-string (*clim-class* *clim-class*)
-	     (excl:with-native-string (*win-name* *win-name*)
+	   (excl:with-native-string (clim-class (acl-clim::clim-class *acl-port*))
+	     (excl:with-native-string (win-name win-name)
 	       (win:CreateWindowEx
 		(if ovl 0 win:WS_EX_TOOLWINDOW)
-		*clim-class*
-		*win-name*
+		clim-class
+		win-name
 		winstyle
 		left top width height
 		parent
 		0
-		*hinst*
-		*win-x*)))))
+		(hinst *acl-port*)
+		(win-x *acl-port*))))))
       (when (zerop window)
 	(check-last-error "CreateWindowEx"))
       window)))
@@ -1403,42 +1360,40 @@
 	;; You can ask for a menu bar on a child window,
 	;; but Windows will not give you one.  
 	(menu 0)
-        (*win-name* *win-name*)
+        (win-name (acl-clim::win-name *acl-port*))
 	(window nil))
     (when pretty
-      (setq *win-name* pretty))
+      (setq win-name pretty))
     (setq window
-      (excl:with-native-string (*clim-class* *clim-class*)
-	(excl:with-native-string (*win-name* *win-name*)
+      (excl:with-native-string (clim-class (acl-clim::clim-class *acl-port*))
+	(excl:with-native-string (win-name win-name)
 	  (win:CreateWindowEx exstyle
-			      *clim-class*
-			      *win-name*
+			      clim-class
+			      win-name
 			      winstyle
 			      left top width height
 			      parent
 			      menu
-			      *hinst*
-			      *win-x*))))
+			      (hinst *acl-port*)
+			      (win-x *acl-port*)))))
     (when (zerop window)
       (check-last-error "CreateWindowEx"))
     (if (or (eql scroll :both)(eql scroll :vertical))
-      (win:SetScrollRange window win:SB_VERT 0 *win-scroll-grain* 1))
+      (win:SetScrollRange window win:SB_VERT 0 (win-scroll-grain *acl-port*) 1))
     (if (or (eql scroll :both)(eql scroll :horizontal))
-      (win:SetScrollRange window win:SB_HORZ 0 *win-scroll-grain* 1))
+      (win:SetScrollRange window win:SB_HORZ 0 (win-scroll-grain *acl-port*) 1))
     window))
 
 ;; wres and wmsg move up in file to remove compile-time warning
 
 (defun wait-for-event ()
   (when (prog1
-            (win:PeekMessage wmsg 0 0 0
+            (win:PeekMessage (wmsg *acl-port*) 0 0 0
 			     (logior win:PM_NOYIELD win:PM_NOREMOVE))
-	  (not (and (zerop (hiword wres)) (zerop (loword wres)))))
+	  (not (and (zerop (hiword (wres *acl-port*)))
+		    (zerop (loword (wres *acl-port*))))))
     t))
 
-(defvar msg (ct:ccallocate win:msg))
-(defvar res (ct:callocate :long))
-
 ;; This is the prototypical way to get and process 
 ;; a windows message from the windows message queue. 
 ;; Note that TAB will not select the next control in
@@ -1450,13 +1405,13 @@
   (loop
     (let ((gotmessage
 	   (if nonblocking
-	       (win:PeekMessage msg 0 0 0 win:PM_REMOVE) 
-	     (win:GetMessage msg 0 0 0))))
+	       (win:PeekMessage (msg *acl-port*) 0 0 0 win:PM_REMOVE) 
+	     (win:GetMessage (msg *acl-port*) 0 0 0))))
       (cond ((not gotmessage) (return t))
-	    ((and hwnd (win:IsDialogMessage hwnd msg)))
+	    ((and hwnd (win:IsDialogMessage hwnd (msg *acl-port*))))
 	    (t 
-	     (win:TranslateMessage msg)
-	     (win:DispatchMessage msg)))
+	     (win:TranslateMessage (msg *acl-port*))
+	     (win:DispatchMessage (msg *acl-port*))))
       (when nonblocking (return t))
       )))
 
@@ -1519,11 +1474,7 @@
 (setf sys::*default-message-interrupt-function*
   #'clim-message-interrupt-function)
 
-(defvar *current-window*)
-(defvar *dc-initialized* nil)
-
 ;;; Stock objects
-(defvar *null-pen*)
 (defvar *black-pen*)
 (defvar *ltgray-pen*)
 (defvar *null-brush*)
@@ -1548,68 +1499,16 @@
     (clim:destroy-port acl-clim::*acl-port*))
 
 
-  (setq *acl-port* nil)
-  (setq *menu-id->command-table*
-    (make-array 256 
-                :element-type t :adjustable t 
-                :fill-pointer 0 :initial-element nil))
-  (setq *popup-menu->menu-item-ids* (make-hash-table))
-  (setq *popup-menu->command-table* (make-hash-table))
-  (setq *maybe-format* nil)
-  (setq *msg-names* nil)
-  (setq *modstate* (make-modstate))
-  (setq *ctlmodstate* (make-modstate))
-  (setq *win-result* 0)
+  (setq *acl-port* nil
+	*maybe-format* nil
+	*level* 0
+	*windows-message-trace-output* excl:*initial-terminal-io*)
+  
 ;;;  (setq *hwnd* 0)
 ;;;  (setq *clim-wproc-arg-struct* nil)
 ;;;  (setq *clim-ctrl-arg-struct* nil)
 ;;;  (setq *tooltip-relay-struct* nil)
-  (setq *level* 0)
-  (setq *realtime-scrollbar-tracking* t)
-  (setq *win-scroll-grain* 1000)
-  (setq wres  (ct:callocate :long))
-  (setq wmsg  (ct:ccallocate win:msg))
-  (setq *windows-message-trace-output* excl:*initial-terminal-io*)
-  (setq *clim-class* "ClimClass")
-  (setq *win-name* "CLIM")
-  (setq *menu-name* "ClimMenu")
-  (setq *win-x* "x")
-  (setq *wndclass-registered* nil)
-  (setq clim-window-proc-address nil)
-  (setq clim-ctrl-proc-address nil)
-  (setq std-ctrl-proc-address nil)
-  (setq tooltip-relay-address nil)
-  (setq *next-windows-hook* nil)
-  (setq *clim-initialized* nil)
-  (setq lpcmdline "")
-  (setq *hinst* 0)
-  (setq *hprevinst* 0)
-  (setq *screen-device* nil)
-  (setq msg (ct:ccallocate win:msg))
-  (setq res (ct:callocate :long))
-
-
-  (setq arrow-cursor 
-    (ff:allocate-fobject 'win:hcursor :foreign-static-gc nil))
-  (setq application-icon 
-    (ff:allocate-fobject 'win:hicon  :foreign-static-gc nil))
-
-
-  (setq *current-window* nil)
-  (setq *dc-initialized* nil)
-
-
-  (setq *null-pen* nil)
-  (setq *black-pen* nil)
-  (setq *ltgray-pen* nil)
-  (setq *null-brush* nil)
-  (setq *black-brush* nil)
-  (setq *ltgray-brush* nil)
-  (setq *blank-image* nil)
-  (setq *ltgray-image* nil)
-
-
-  (setq *background-brush* nil)
+  
   )
 
 (push #'reset-aclpc-clim excl::*restart-actions*)
diff --git a/aclpc/acl-dc.lisp b/aclpc/acl-dc.lisp
index ce041cb0fa9bbfc7c8bc7cd45db82ec3257854be..be6113f53fc7b0a3a852fc5dbcc2d6c51907efb9 100644
--- a/aclpc/acl-dc.lisp
+++ b/aclpc/acl-dc.lisp
@@ -17,7 +17,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 2.7 2007/04/17 21:45:48 layer Exp $
+;; $Id: acl-dc.lisp,v 2.8 2007/04/25 20:29:26 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -83,59 +83,59 @@
     dc))
 
 (defun initialize-dc ()
-  (unless *dc-initialized*
-    (unless (win:IsWindow *current-window*)
-      (error "No Window: ~S" *current-window*))
+  (unless (dc-initialized *acl-port*)
+    (unless (win:IsWindow (current-window *acl-port*))
+      (error "No Window: ~S" (current-window *acl-port*)))
     ;; Stock objects
-    (setf *null-pen* (win:GetStockObject win:NULL_PEN))
-    (setf *black-pen* (win:GetStockObject win:BLACK_PEN))
-    (setf *ltgray-pen* 
+    (setf (null-pen *acl-port*)(win:GetStockObject win:NULL_PEN))
+    (setf (black-pen *acl-port*)(win:GetStockObject win:BLACK_PEN))
+    (setf (ltgray-pen *acl-port*)
       (CreatePen win:PS_SOLID 1 (win:GetSysColor win:COLOR_BTNFACE)))
     ;;
-    (setf *null-brush* (win:GetStockObject win:NULL_BRUSH))
-    (setf *black-brush* (win:GetStockObject win:BLACK_BRUSH))
-    (setf *ltgray-brush* 
+    (setf (null-brush *acl-port*)(win:GetStockObject win:NULL_BRUSH))
+    (setf (black-brush *acl-port*)(win:GetStockObject win:BLACK_BRUSH))
+    (setf (ltgray-brush *acl-port*)
       (win:CreateSolidBrush (win:GetSysColor win:COLOR_BTNFACE)))
 
-    (setf *blank-image*
-      #+possibly
-      (make-dc-image :solid-1-pen *black-pen* 
-		     :brush *black-brush*
+    (setf (blank-image *acl-port*)
+	  #+possibly
+      (make-dc-image :solid-1-pen (black-pen *acl-port*) 
+		     :brush (black-brush *acl-port*)
 		     :text-color #xffffffff ; see CLR_NONE
 		     :background-color nil
 		     :rop2 win:R2_MERGEPEN )
-      (make-dc-image :solid-1-pen *black-pen*
-		     :brush *black-brush*
+      (make-dc-image :solid-1-pen (black-pen *acl-port*)
+		     :brush (black-brush *acl-port*)
 		     :text-color #x000000 
 		     :background-color nil
 		     :rop2 win:R2_NOP ))
     ;;
-    (setf *ltgray-image*
-      (make-dc-image :solid-1-pen *ltgray-pen* 
-		     :brush *ltgray-brush*
-		     :text-color (win:GetSysColor win:COLOR_BTNFACE)
-		     :background-color nil
-		     :rop2 win:R2_COPYPEN))
+    (setf (ltgray-image *acl-port*)
+	  (make-dc-image :solid-1-pen (ltgray-pen *acl-port*) 
+			 :brush (ltgray-brush *acl-port*)
+			 :text-color (win:GetSysColor win:COLOR_BTNFACE)
+			 :background-color nil
+			 :rop2 win:R2_COPYPEN))
     ;;
-    (setq *dc-initialized* t)
+    (setf (dc-initialized *acl-port*) t)
     ))
 
 (defun destroy-dc ()
-  (when *dc-initialized*
-    (setq *null-pen* nil)
-    (setq *null-brush* nil)
+  (when (dc-initialized *acl-port*)
+    (setf (null-pen *acl-port*) nil
+	  (null-brush *acl-port*) nil)
   
-    (destroy-dc-image *blank-image*)
-    (setq *black-pen* nil)
-    (setq *black-brush* nil)
-    (setq *blank-image* nil)
+    (destroy-dc-image (blank-image *acl-port*))
+    (setf (black-pen *acl-port*) nil
+	  (black-brush *acl-port*) nil
+	  (blank-image *acl-port*) nil)
   
-    (destroy-dc-image *ltgray-image*)
-    (setq *ltgray-pen* nil)
-    (setq *ltgray-image* nil)
-    (setq *ltgray-brush* nil)
+    (destroy-dc-image (ltgray-image *acl-port*))
+    (setf (ltgray-pen *acl-port*) nil
+	  (ltgray-image *acl-port*) nil
+	  (ltgray-brush *acl-port*) nil)
     
-    (setq *dc-initialized* nil)))
+    (setf (dc-initialized *acl-port*) nil)))
 
 ;;;
 
@@ -221,7 +221,7 @@
   (let* ((dashes (line-style-dashes line-style))
 	 (thickness (max 1 (round (line-style-thickness line-style))))
 	 (code (if dashes (- thickness) thickness))
-	 (brush *null-brush*)
+	 (brush (null-brush *acl-port*))
 	 (pen (when (= code 1) (dc-image-solid-1-pen image)))
 	 (rop2 (dc-image-rop2 image))
 	 (text-color (dc-image-text-color image))
@@ -253,7 +253,7 @@
   (let ((background-color (dc-image-background-color image))
         (text-color (dc-image-text-color image))
 	(brush (dc-image-brush image))
-	(pen *null-pen*)
+	(pen (null-pen *acl-port*))
 	(rop2 (dc-image-rop2 image)))
     (when (valid-handle pen) (SelectObject dc pen))
     (when background-color
@@ -293,7 +293,8 @@
 					      ,xorg ,yorg))
 	   ,@body)
        (when (valid-handle ..winpen..)
-	 (when (valid-handle *black-pen*) (SelectObject ,dc *black-pen*))
+	 (when (valid-handle (black-pen *acl-port*))
+	   (SelectObject ,dc (black-pen *acl-port*)))
 	 (or (win:DeleteObject ..winpen..) 
 	     (error "with-set-dc-for-ink: DeleteObject"))))))
 
diff --git a/aclpc/acl-frames.lisp b/aclpc/acl-frames.lisp
index ed1dd0eef79ef68c330ae086179d52a48703c28b..be2f8b6cc37b3034a3f1bdf99b6ac5278ead754f 100644
--- a/aclpc/acl-frames.lisp
+++ b/aclpc/acl-frames.lisp
@@ -17,7 +17,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 2.11 2007/04/17 21:45:48 layer Exp $
+;; $Id: acl-frames.lisp,v 2.12 2007/04/25 20:29:26 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -149,7 +149,7 @@
 (defmethod frame-manager-default-exit-boxes ((framem acl-frame-manager))
   '((:exit) (:abort)))
 
-;; Note: items appear never to be removed from *menu-id->command-table*
+;; Note: items appear never to be removed from menu-id->command-table
 ;; so this will grow indefinitely (cim 9/9/96). There really should be
 ;; a global id counter and the association list should be kept on a
 ;; per application-frame basis. 
@@ -159,8 +159,8 @@
   ;; It is allowed for the UNIX port, apparently.
   (when (atom command) (setq command (list command)))
   (prog1
-    (fill-pointer *menu-id->command-table*)
-    (vector-push-extend (cons frame command) *menu-id->command-table*
+    (fill-pointer (menu-id->command-table *acl-port*))
+    (vector-push-extend (cons frame command) (menu-id->command-table *acl-port*)
 			256)))
 
 (defun find-command-menu-item-id (command frame)
@@ -171,11 +171,11 @@
 	       (c (second x)))
 	   (and (eq f frame)
 		(eq c command)))))
-   *menu-id->command-table*))
+   (menu-id->command-table *acl-port*)))
 
 (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)))
+  (dotimes (id (fill-pointer (menu-id->command-table *acl-port*)))
+    (let ((x (aref (menu-id->command-table *acl-port*) id)))
       (when x
 	(let ((f (first x)))
 	  (if (eq f frame) (apply func id args)))))))
@@ -212,7 +212,8 @@
   (map-command-menu-ids
    frame
    #'(lambda (menuid)
-       (let ((command-name (second (aref *menu-id->command-table* menuid))))
+       (let ((command-name (second (aref (menu-id->command-table *acl-port*)
+					 menuid))))
 	 (with-slots (clim-internals::disabled-commands) frame
 	   (push command-name clim-internals::disabled-commands)))))
   )
@@ -420,7 +421,7 @@
     (setq top-level-sheet (frame-top-level-sheet frame)))
   ;; First, delete any pre-existing menu items.
   (delete-menu-bar frame menuhand t)
-  (setf (gethash menuhand *popup-menu->menu-item-ids*) nil) 
+  (setf (gethash menuhand (popup-menu->menu-item-ids *acl-port*)) nil) 
   (setf (gethash menuhand *popup-menu->command-table*) 
     (list command-table 
 	  (slot-value (find-command-table command-table)
@@ -461,7 +462,7 @@
 		 flags
 		 menu-item-id
 		 m))
-	      (push menu-item-id (gethash menuhand *popup-menu->menu-item-ids*))))
+	      (push menu-item-id (gethash menuhand (popup-menu->menu-item-ids *acl-port*)))))
 	   (:function
 	    (warn ":function not yet implemented in menu bars")
 	    )
@@ -516,8 +517,8 @@
   ;; Called just before making a menu active.  If the menu is associated
   ;; with a command table, make sure to enable or gray the menu
   ;; items appropriately.
-  (dolist (menu-item-id (gethash hmenu *popup-menu->menu-item-ids*))
-    (let* ((item (aref *menu-id->command-table* menu-item-id))
+  (dolist (menu-item-id (gethash hmenu (popup-menu->menu-item-ids *acl-port*)))
+    (let* ((item (aref (menu-id->command-table *acl-port*) menu-item-id))
 	   (frame (first item))
 	   (command (second item))
 	   (top (frame-top-level-sheet frame))
@@ -576,7 +577,7 @@
 			  win:CW_USEDEFAULT win:CW_USEDEFAULT
 			  win:CW_USEDEFAULT win:CW_USEDEFAULT 
 			  0 0
-			  *hinst* 0))
+			  (hinst *acl-port*) 0))
       (setf (tooltip-control sheet) tooltip-control)
       (when (zerop tooltip-control)
 	(check-last-error "CreateWindow" :action :warn)
@@ -594,7 +595,7 @@
 		hwnd (sheet-mirror sheet)
 		uid (sheet-mirror s)
 		;;rect 0
-		hinst *hinst*
+		hinst (hinst *acl-port*)
 		lpsztext -1 
 		#+ign
 		(lisp-string-to-scratch-c-string 
@@ -2271,7 +2272,8 @@ in a second Lisp process.  This frame cannot be reused."
                                edit-box dont-go-below-domains
 				    include-files)
   ;; Ensure that the callback procedure is registered.
-  (unless (and *clim-initialized* *clim-browse-callback-proc-address*)
+  (unless (and (clim-initialized-p *acl-port*)
+	       *clim-browse-callback-proc-address*)
     (setf *clim-browse-callback-proc-address*
           (ff:register-foreign-callable 'browse-callback-proc
                                         :reuse :return-value)))
diff --git a/aclpc/acl-medium.lisp b/aclpc/acl-medium.lisp
index 845a1103e05f048d505f08ffc0cb2c11bf1ef17e..d0c42496130f56948e239c7511afc3825226fa20 100644
--- a/aclpc/acl-medium.lisp
+++ b/aclpc/acl-medium.lisp
@@ -17,7 +17,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 2.9 2007/04/17 21:45:48 layer Exp $
+;; $Id: acl-medium.lisp,v 2.10 2007/04/25 20:29:26 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -166,7 +166,7 @@
   ;; used by Windows for all the other gadgets, such as
   ;; buttons and scroll bars.  MFC calls this "light
   ;; gray in the current color scheme"
-  *ltgray-image*)
+  (ltgray-image *acl-port*))
 
 (defmethod color-rgb ((color (eql +ltgray+)))
   (color-rgb (wincolor->color (win:GetSysColor win:COLOR_BTNFACE))))
@@ -1816,7 +1816,7 @@ device-independent bitmap, an icon, nor a cursor."))
 (defun icon-height () (win:GetSystemMetrics win:SM_CYICON))
 
 (defun create-icon (pixmap texture-info mask-bitmap) ;; <7>
-  (win:CreateIcon *hinst*
+  (win:CreateIcon (hinst *acl-port*)
 		  (icon-width)
 		  (icon-height)
 		  1 ;; planes (texture-info-bits-per-pixel texture-info)
diff --git a/aclpc/acl-mirror.lisp b/aclpc/acl-mirror.lisp
index b3c8834144a7e01ccab52bdb034a596d0e37180d..2d5f25802079fa7329ad912e41f6a60ee9e73a64 100644
--- a/aclpc/acl-mirror.lisp
+++ b/aclpc/acl-mirror.lisp
@@ -17,7 +17,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 2.7 2007/04/17 21:45:48 layer Exp $
+;; $Id: acl-mirror.lisp,v 2.8 2007/04/25 20:29:26 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -37,7 +37,7 @@
 (defmethod sheet-shell (sheet) sheet)
 
 (defmethod realize-graft ((port acl-port) graft)
-  (let ((screen (slot-value *screen-device* 'device-handle1)))
+  (let ((screen (slot-value (screen-device *acl-port*) 'device-handle1)))
    (setf (port-screen port) screen)
    (init-cursors)
    (with-slots (silica::pixels-per-point
@@ -206,8 +206,8 @@
         (setf (sheet-event-queue sheet) (make-acl-event-queue)))
       (when control (setf (silica::gadget-id->window sheet gadget-id) window)) 
       (unless (or control msscrollwin)
-        (setq *current-window* window)
-	(unless *dc-initialized* (initialize-dc))
+        (setf (current-window port) window)
+	(unless (dc-initialized port) (initialize-dc))
 	(with-dc (window dc)
           (with-slots (logpixelsy) port
             (setf logpixelsy (win:GetDeviceCaps dc win:LOGPIXELSY)))))
diff --git a/aclpc/acl-port.lisp b/aclpc/acl-port.lisp
index a3acbfaafedbe420d9ac9da84eadb9c26f8fc912..33ca8bb89c798b5a5382db8f3cd487401c461d36 100644
--- a/aclpc/acl-port.lisp
+++ b/aclpc/acl-port.lisp
@@ -17,7 +17,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 2.11 2007/04/17 21:45:48 layer Exp $
+;; $Id: acl-port.lisp,v 2.12 2007/04/25 20:29:26 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -143,7 +143,15 @@
 
 (defclass acl-event-queue (queue)
     ())
-  
+
+(defun msg-names-initform ()
+  (let ((msg-names (make-array 4096)))
+    (dolist (x (remove-duplicates
+		(apropos-list "WM_" (find-package :win))))
+      (when (<= 0 (symbol-value x) 4095)
+	(push x (svref msg-names (symbol-value x)))))
+    msg-names))
+
 (define-constructor make-acl-event-queue queue () )
 
 (defclass acl-port (basic-port)
@@ -177,7 +185,102 @@
 			:accessor port-rotated-font-htable)   
    ;; Pixmaps
    (pixmaps :initform nil :accessor port-pixmaps)
-   ))
+
+   ;; automatically transformed from special vars.
+
+   ;; this will grow indefinitely as menu-ids are never removed (cim 9/10/96)
+   (menu-id->command-table :initform (make-array 256 
+						 :element-type t
+						 :adjustable t 
+						 :fill-pointer 0
+						 :initial-element nil)
+			   :accessor menu-id->command-table)
+
+   ;; this will grow indefinitely as items are never removed (cim 9/10/96)
+   (popup-menu->menu-item-ids :initform (make-hash-table)
+			      :accessor popup-menu->menu-item-ids)
+   (popup-menu->command-table :initform (make-hash-table)
+			      :accessor popup-menu->command-table)
+   (msg-names :initform (msg-names-initform)
+	      :accessor msg-names)
+   (modstate :initform (make-modstate)
+	     :accessor modstate)
+   (ctlmodstate :initform (make-modstate)
+		:accessor ctlmodstate)
+   (win-result :initform 0
+	       :accessor win-result)
+
+   ;; Must be a 16-bit quantity.
+   ;; According to Microsoft, WM_HSCROLL and WM_VSCROLL messages
+   ;; are "limited to 16 bits of position data".
+   ;; (alemmens, 2004-12-17)
+   (win-scroll-grain :initform (1- (expt 2 16))
+		     :accessor win-scroll-grain)
+
+   (wres :initform  (ct:callocate :long) 	
+	 :accessor wres)
+   (wmsg :initform  (ct:ccallocate win:msg)
+	 :accessor wmsg)
+   (clim-class :initform "ClimClass" 
+	       :accessor clim-class)
+   (win-name :initform "CLIM"
+	     :accessor win-name)
+   (win-x :initform "x"
+	  :accessor win-x)
+   (wndclass-registered :initform nil
+			:accessor wndclass-registered)
+   (clim-window-proc-address :initform nil
+			     :accessor clim-window-proc-address)
+   (clim-ctrl-proc-address :initform nil
+			   :accessor clim-ctrl-proc-address)
+   (std-ctrl-proc-address :initform nil
+			  :accessor std-ctrl-proc-address)
+   (tooltip-relay-address :initform nil
+			  :accessor tooltip-relay-address)
+   (next-windows-hook :initform nil
+		      :accessor next-windows-hook)
+   (clim-initialized-p :initform nil
+		       :accessor clim-initialized-p)
+   (lpcmdline :initform ""
+	      :accessor lpcmdline)
+   (hinst :initform 0
+	  :accessor hinst)
+   (screen-device :initform nil 
+		  :accessor screen-device)
+   (msg :initform (ct:ccallocate win:msg)
+	:accessor msg)
+   (arrow-cursor :initform
+		 (ff:allocate-fobject 'win:hcursor :foreign-static-gc nil)
+		 :accessor arrow-cursor)
+   (application-icon :initform 
+		     (ff:allocate-fobject 'win:hicon  :foreign-static-gc nil)
+		     :accessor application-icon)
+   (current-window :initform nil
+		   :accessor current-window)
+   (dc-initialized :initform nil
+		   :accessor dc-initialized)
+   (null-pen :initform nil
+	     :accessor null-pen)
+   (black-pen :initform nil
+	      :accessor black-pen)
+   (ltgray-pen :initform nil
+	       :accessor ltgray-pen)
+   (null-brush :initform nil
+	       :accessor null-brush)
+   (black-brush :initform nil
+		:accessor black-brush)
+   (ltgray-brush :initform nil
+		 :accessor ltgray-brush)
+   (blank-image :initform nil
+		:accessor blank-image)
+   (ltgray-image :initform nil
+		 :accessor ltgray-image)
+   (background-brush :initform nil
+		     :accessor background-brush)))
+
+(defun acl-clim-initialized-p (port)
+  (and (slot-boundp port 'clim-initialized-p)
+       (clim-initialized-p port)))
 
 (defmethod restart-port ((port acl-port))
   ;; No need to devote a thread to receiving messages
@@ -254,7 +357,7 @@
     (setf (medium-text-style medium) style)))
 
 (defmethod initialize-instance :before ((port acl-port) &key)
-  (ensure-clim-initialized)
+  (ensure-clim-initialized port)
   (unless (null *acl-port*)
     (cerror "do it anyway" "There can only be one acl port."))
   (setf *acl-port* port))
@@ -268,15 +371,13 @@
     (setf silica::deep-mirroring t)
     (register-window-class (realize-cursor port :default))
     ;;(get-clim-icon) +++
-    (let ((res (ct:callocate :long)))
-      (loop for (vk . keysym) in *vk->keysym* do
+    (loop for (vk . keysym) in *vk->keysym* do
 	    (setf (gethash vk vk->keysym) keysym))
-      (loop for code from (char-code #\!) to (char-code #\~)
+    (loop for code from (char-code #\!) to (char-code #\~)
 	  for char = (code-char code)
 	  do
-	    (let ((scan (loword (win:VkKeyScan code))))
-	      (push char (gethash scan vk->keysym))))
-      )
+	 (let ((scan (loword (win:VkKeyScan code))))
+	       (push char (gethash scan vk->keysym))))
     ;; Panes that have a direct mirror will get initialized from
     ;; get-sheet-resources:
     (setf (port-default-resources port)
@@ -639,7 +740,7 @@ or (:style . (family face size))")
 		 (frame-top-level-sheet *application-frame*)
 		 (sheet-mirror (frame-top-level-sheet *application-frame*))))
 	(tmstruct (ct:ccallocate win:textmetric)))
-    (unless cw (setf cw *current-window*))
+    (unless cw (setf cw (current-window *acl-port*)))
     (unless (win:IsWindow cw) 
       ;; This clause is for the rare case that you are doing drawing
       ;; from a background process the first time you attempt to use
@@ -932,8 +1033,8 @@ or (:style . (family face size))")
 ;;; the variable *modstate*, set in onkeydown (in aclpc/acl-class.lisp)
 (defun windows-mask->modifier-state+ (mask &optional double)
   (let ((state (windows-mask->modifier-state mask double)))
-    (when (and *modstate*
-               (modstate-meta *modstate*))
+    (when (and (modstate *acl-port*)
+               (modstate-meta (modstate *acl-port*)))
       (setq state (logior state (make-modifier-state :meta))))
     state))
 
diff --git a/aclpc/acl-prel.lisp b/aclpc/acl-prel.lisp
index f0c75aa30e91e85fdc01510c43b1abbf3319b398..8f9c30db55e080321a402df06d7a407c09801263 100644
--- a/aclpc/acl-prel.lisp
+++ b/aclpc/acl-prel.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-prel.lisp,v 2.11 2007/04/17 21:45:48 layer Exp $
+;; $Id: acl-prel.lisp,v 2.12 2007/04/25 20:29:26 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -29,11 +29,12 @@
 
 (in-package :acl-clim)
 
+
+(declaim (special *acl-port*))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Open a combo box control.
 
-(declaim (special *hinst*))
-
 (defun combobox-scroll-bars (items)
   ;; If there are many items, you won't be able 
   ;; to see them without a scroll bar.
@@ -65,7 +66,7 @@
 		win:CBS_DROPDOWNLIST)
 	       0 0 0 0
 	       parent 0
-	       *hinst* (symbol-name (gensym)))))))
+	       (hinst *acl-port*) (symbol-name (gensym)))))))
     (if (zerop hwnd)
 	;; failed
 	(cerror "proceed" "failed")
@@ -134,7 +135,7 @@
 				  0 0 0 0
 				  parent
 				  0
-				  *hinst*
+				  (hinst *acl-port*)
 				  (symbol-name (gensym)))))))
     (if (zerop hwnd)
 	;; failed
@@ -204,7 +205,7 @@
 	       0 0 0 0			; x, y, width, height
 	       parent
 	       0
-	       *hinst*
+	       (hinst *acl-port*)
 	       (symbol-name (gensym)))))))
     (if (zerop hwnd)
 	;; failed
@@ -258,7 +259,7 @@
 				    0 0 0 0
 				    parent
 				    0
-				    *hinst*
+				    (hinst *acl-port*)
 				    (symbol-name (gensym)))))))
       (if (zerop hwnd)
 	  ;; failed
@@ -274,8 +275,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Open an edit control
 
-(declaim (special std-ctrl-proc-address clim-ctrl-proc-address))
-
 (defun hedit-open (parent id left top width height 
 		   &key (editstyle 0)
 		        (value nil)
@@ -305,7 +304,7 @@
               0 0 0 0
               parent
               0
-              *hinst*
+              (hinst *acl-port*)
               (symbol-name (gensym)))))))
     (cond ((zerop hwnd)
            (cerror "Continue anyway." "Can't create text-edit gadget.")
@@ -318,11 +317,11 @@
                ;; spr 30683 (alemmens, 2005-11-30)
                (win:SetWindowText hwnd s1)))
            ;; Override the default window proc.
-           (setf std-ctrl-proc-address
+           (setf (std-ctrl-proc-address *acl-port*)
                  (win:GetWindowLong hwnd win:GWL_WNDPROC))
            (win:SetWindowLong hwnd
                               win:GWL_WNDPROC
-                              clim-ctrl-proc-address)
+                              (clim-ctrl-proc-address *acl-port*))
            (win:SetWindowPos hwnd 0 
                              left top width height
                              #.(logior win:SWP_NOACTIVATE win:SWP_NOZORDER))
diff --git a/aclpc/acl-scroll.lisp b/aclpc/acl-scroll.lisp
index 971c93d8e1af02050cafc646348e086ea631ecde..a76f0bebf6feb34ea08268adaf077ac1cc163a28 100644
--- a/aclpc/acl-scroll.lisp
+++ b/aclpc/acl-scroll.lisp
@@ -17,7 +17,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: acl-scroll.lisp,v 2.8 2007/04/17 21:45:48 layer Exp $
+;; $Id: acl-scroll.lisp,v 2.9 2007/04/25 20:29:26 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -259,13 +259,13 @@
 		(struct (ct:ccallocate win:scrollinfo))
 		(bar (if (eq orientation :vertical) 
 			 win:SB_VERT win:SB_HORZ))
-		(page (floor (* size acl-clim::*win-scroll-grain*)))
-		(position (floor (* pos acl-clim::*win-scroll-grain*))))
+		(page (floor (* size (acl-clim::win-scroll-grain acl-clim::*acl-port*))))
+		(position (floor (* pos (acl-clim::win-scroll-grain acl-clim::*acl-port*)))))
 	    (ct:csets win:scrollinfo struct
 		      cbSize (ct:sizeof win:scrollinfo)
 		      fMask win:SIF_ALL
 		      nMin 0
-		      nMax acl-clim::*win-scroll-grain*
+		      nMax (acl-clim::win-scroll-grain acl-clim::*acl-port*)
 		      nPage page
 		      nPos position)
 	    (win:SetScrollInfo mirror bar struct 1))
@@ -311,7 +311,7 @@
 		   (:vertical win:SB_VERT)
 		   (:horizontal win:SB_HORZ)))
 	   (current-value (/ (win:GetScrollPos window flag)
-			     (float acl-clim::*win-scroll-grain*)))
+			     (float (acl-clim::win-scroll-grain acl-clim::*acl-port*))))
 	   (current-size (case orientation
 			   (:horizontal current-horizontal-size)
 			   (:vertical  current-vertical-size)))
@@ -338,7 +338,7 @@
 		   (:horizontal win:SB_HORZ)))
 	   (window (sheet-mirror scroller-pane))
 	   (current-value (/ (win:GetScrollPos window flag)
-			     (float acl-clim::*win-scroll-grain*)))
+			     (float (acl-clim::win-scroll-grain acl-clim::*acl-port*))))
 	   (current-size (case orientation
 			   (:horizontal current-horizontal-size)
 			   (:vertical  current-vertical-size)))
@@ -349,8 +349,8 @@
 			   (/ (line-scroll-amount
 			       scroller-pane orientation :down)
 			      (float contents-range  0.0s0)))))
-	   (new-value (min (- (/ (1+ acl-clim::*win-scroll-grain*) ;; max size
-				 acl-clim::*win-scroll-grain*) ;; max pos
+	   (new-value (min (- (/ (1+ (acl-clim::win-scroll-grain acl-clim::*acl-port*)) ;; max size
+				 (acl-clim::win-scroll-grain acl-clim::*acl-port*)) ;; max pos
 			      current-size)
 			   (+ current-value line-value))))
       (scroll-bar-value-changed-callback
@@ -366,7 +366,7 @@
 		   (:horizontal win:SB_HORZ)))
 	   (window (sheet-mirror scroller-pane))
 	   (current-value (/ (win:GetScrollPos window flag)
-			     (float acl-clim::*win-scroll-grain*)))
+			     (float (acl-clim::win-scroll-grain acl-clim::*acl-port*))))
 	   (current-size (case orientation
 			   (:horizontal current-horizontal-size)
 			   (:vertical  current-vertical-size)))
@@ -391,7 +391,7 @@
 		   (:horizontal win:SB_HORZ)))
 	   (window (sheet-mirror scroller-pane))
 	   (current-value (/ (win:GetScrollPos window flag)
-			     (float acl-clim::*win-scroll-grain*)))
+			     (float (acl-clim::win-scroll-grain acl-clim::*acl-port*))))
 	   (current-size (case orientation
 			   (:horizontal current-horizontal-size)
 			   (:vertical  current-vertical-size)))
@@ -402,8 +402,8 @@
 	  (setq new-value current-value)
 	(let ((page-value (the single-float 
 			    (/ viewport-range (float contents-range 0.0s0)))))
-	  (setq new-value (min (- (/ (1+ acl-clim::*win-scroll-grain*)
-				     acl-clim::*win-scroll-grain*)
+	  (setq new-value (min (- (/ (1+ (acl-clim::win-scroll-grain acl-clim::*acl-port*))
+				     (acl-clim::win-scroll-grain acl-clim::*acl-port*))
 				  current-size)
 			       (+ current-value page-value)))))
       (scroll-bar-value-changed-callback
@@ -417,7 +417,7 @@
     (let* ((current-size (case orientation
 			   (:horizontal current-horizontal-size)
 			   (:vertical  current-vertical-size)))
-	   (new-value (/ pos (float acl-clim::*win-scroll-grain*))))
+	   (new-value (/ pos (float (acl-clim::win-scroll-grain acl-clim::*acl-port*)))))
       (scroll-bar-value-changed-callback
        scroller-pane scroller-pane orientation new-value current-size))))
 
diff --git a/aclpc/acl-widget.lisp b/aclpc/acl-widget.lisp
index 1b474cffac6500de913e66559faefe8ad8b85682..3748177961c06f1e11b7b09b6c4c891aa1e30476 100644
--- a/aclpc/acl-widget.lisp
+++ b/aclpc/acl-widget.lisp
@@ -17,7 +17,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 2.13 2007/04/17 21:45:48 layer Exp $
+;; $Id: acl-widget.lisp,v 2.14 2007/04/25 20:29:26 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -1610,7 +1610,7 @@
 
 
 (defmethod native-gadget-range* ((scroll-bar mswin-scroll-bar))
-  (values 0 acl-clim::*win-scroll-grain*))
+  (values 0 (acl-clim::win-scroll-grain acl-clim::*acl-port*)))
 
 
 (defmethod realize-mirror ((port acl-clim::acl-port) (sheet mswin-scroll-bar))
@@ -1687,7 +1687,7 @@
          cbSize (ct:sizeof win:scrollinfo)
          fMask win:SIF_ALL
          nMin 0
-         nMax acl-clim::*win-scroll-grain*
+         nMax (acl-clim::win-scroll-grain acl-clim::*acl-port*)
          nPage page
          nPos position)
         (win:SetScrollInfo mirror win:SB_CTL struct 1)))))
@@ -2026,16 +2026,16 @@
 	(exstyle win:WS_EX_CLIENTEDGE)
 	(window nil))
     (setq window
-      (excl:with-native-string (*clim-class* *clim-class*)
-	(excl:with-native-string (*win-name* *win-name*)
+      (excl:with-native-string (clim-class (clim-class *acl-port*))
+	(excl:with-native-string (win-name (win-name *acl-port*))
 	  (win:CreateWindowEx exstyle
-			      *clim-class*
-			      *win-name*
+			      clim-class
+			      win-name
 			      winstyle
 			      left top width height
 			      (or parent 0)
 			      0		; menu
-			      *hinst*
+			      (hinst *acl-port*)
 			      (symbol-name (gensym)) )))) 
     (when (zerop window)
       (or (check-last-error "CreateWindowEx")
diff --git a/sys/odrawpat.lisp b/sys/odrawpat.lisp
index da738aeb1e63ea00dbe421d1252553421f86a7c4..69e8d9839fd1c45136245fb1c3419c2a48a49938 100644
--- a/sys/odrawpat.lisp
+++ b/sys/odrawpat.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: odrawpat.lisp,v 2.7 2007/04/17 21:45:52 layer Exp $
+;; $Id: odrawpat.lisp,v 2.8 2007/04/25 20:29:26 layer Exp $
 
 (in-package :acl-clim)
 
@@ -31,18 +31,18 @@
 			  (if (or (eql scroll :both)(eql scroll :horizontal))
 			    win:ws_hscroll 0)
 			  win:ws_clipsiblings))
-        (*win-name* *win-name*)
+        (win-name (win-name *acl-port*))
         (cstr (ct:callocate (:char *) :size 256))
 	(subsize (when pretty (length pretty)))
 	(window nil))
     (when pretty
       (dotimes (i subsize)
         (ct:cset (:char 256) cstr ((fixnum i)) (char-int (char pretty i))))
-      (setq *win-name* cstr))
+      (setq win-name cstr))
     (setq window
 	  (win:createWindow
-		*clim-class* ; cl-user::clim-class ; "ClimClass"
-		*win-name*   ; "CLIM"
+		(clim-class *acl-port*)	   ; cl-user::clim-class ; "ClimClass"
+		win-name   ; "CLIM"
 		winstyle
 		left top width height
 		parent