diff --git a/ChangeLog.n b/ChangeLog.n
index 82fc08b52beaeaa526fe66f04e51e083eee0f4b4..8f161337a956f42483711e5d44c3a7dea5414200 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -10,6 +10,10 @@ Tests for new features:	<`no new features', `no tests for new features', or
 <standard changelog date stamp>
 	* <changes go here...>
 
+*******************************************************************************
+2.2.2.3 -- join from acl50 branch
+next merge tag: acl50_merge3
+
 *******************************************************************************
 Tue Sep 29 22:55:00 1998  Duane Rettig  <duane@beta>
 
@@ -43,6 +47,51 @@ 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.32
+
+Sat Sept 19 12:00:00 1998  Jeff Morrill <jmorrill@pointnclick.com>
+
+	* clim/frames, clim/gestures, silica/classes, tk-silica/xm-frames: 
+           enhancement to support double-click gesture
+      * clim/output-protocol: add (setf stream-default-view) 
+           for string-output-stream (resolve missing method error)
+      * aclpc/winwidgh, aclpc/acl-frames, aclpc/acl-class: 
+           partial solution to support tooltips
+      * aclpc/acl-widget: fixes for checkbox, fix (setf gadget-value)
+           to anticipate the callback might do a throw, cleanups
+      * aclpc/acl-port: fix problem mapping text styles to the right font
+      * aclpc/acl-mirror: fix for checkbox
+      * aclpc/acl-medium: partial solution to transparent rectangular tile
+      * aclpc/acl-frames: bulletproofing for select-file, fix menubar to
+           see command name only, cleanup
+      * aclpc/acl-class: handle dblclick events correctly, cleanup
+
+*******************************************************************************
+2.2.1.31
+
+Wed Aug 12 12:00:00 1998  Jeff Morrill <jmorrill@pointnclick.com>
+
+	* silica/db-label: fix handle-repaint of generic-label-pane
+        * aclpc/acl-class: scroll correctly in scroll-bars, update menu bars
+        * aclpc/acl-dc: fixes for flipping-ink, dashed lines, stipples
+        * aclpc/acl-frames: update menu bars, fix select-file segv,
+            keep noting-progress from hanging
+        * aclpc/acl-medium: make color->wincolor more accurate, fix
+            stipples and draw-pattern*
+        * aclpc/acl-port: keep the event processor from hanging lisp
+        * aclpc/acl-prel: fixes for stipples and draw-pattern*
+        * aclpc/acl-scroll: scroll correctly in scroll-bars
+        * aclpc/acl-widget: scroll correctly in scroll-bars
+
+*******************************************************************************
+2.2.1.30
+
+Wed Aug 12 09:22:38 1998  Kevin Layer  <layer@ultra>
+
+	* utils/last.lisp: bug7227: add version specification to
+	load-patches
+
 *******************************************************************************
 2.2.1.29
 
diff --git a/aclpc/acl-class.lisp b/aclpc/acl-class.lisp
index 0930217e361a5050535b415d331f22b49c465ed3..bb06074f04380bae813f053cfe7a1573b3e1cfd4 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.9 1998/08/06 23:15:41 layer Exp $
+;; $Id: acl-class.lisp,v 1.10 1998/10/08 18:36:19 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -33,11 +33,15 @@
 
 ;; 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))
+    (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))
+(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))
 
 (defstruct modstate
   (numlock nil)
@@ -131,6 +135,7 @@
 
 (defvar *clim-wproc-arg-struct* nil)
 (defvar *clim-ctrl-arg-struct* nil)
+(defvar *tooltip-relay-struct* nil)
 
 (defstruct (PCCStructure 
 	    (:print-function print-pccstructure)
@@ -165,6 +170,11 @@
   (setf *clim-wproc-arg-struct* arg-struct)
   (ff:register-function 'clim-wind-proc :reuse :return-value))
 
+(defun init-tooltip-relay (wproc-address arg-struct)
+  (declare (ignore wproc-address))
+  (setf *tooltip-relay-struct* arg-struct)
+  (ff:register-function 'tooltip-relay :reuse :return-value))
+
 (defun init-clim-ctrl-proc (wproc-address arg-struct)
   (declare (ignore wproc-address))
   (setf *clim-ctrl-arg-struct* arg-struct)
@@ -231,7 +241,7 @@
 	(sheet (mirror->sheet *acl-port* window)))
     (declare (ignore keys))
     (setq *win-result*
-      (if (note-pointer-motion *acl-port* sheet mx my)
+      (if (or (not sheet) (note-pointer-motion *acl-port* sheet mx my))
 	  (win:defwindowproc window msg wparam lparam)
 	win:false))))
 
@@ -316,148 +326,115 @@
 	 
 	 (setf *win-result* (adjust-gadget-colors sheet hdc))))))
 
-;; Process WM_COMMAND
+;; Process WM_COMMAND.
+;; This message is sent when the user selects a command item
+;; from a menu, when a control sends a notification message to
+;; its parent window, or when an accelerator key is translated.
 (defun oncommand (window msg wparam lparam)
   (declare (ignore msg))
-  (let ((wloword (loword wparam))
-	(whiword (hiword wparam))
-	(sheet (mirror->sheet *acl-port* window))
-	(pointer (port-pointer *acl-port*))
-	(modifier-state (make-modifier-state))
-	(gadget nil)
-	(hwnd (ct:ccallocate win:hwnd)))
-    ;;mm: defined in acl-mirr.lsp later
-    (declare (special *gadget-id->window*))
-    (when pointer
-      (flush-pointer-motion *acl-port*))
-    (cond ((and (zerop lparam)		; menu item
-		(zerop whiword))	; otherwise control (or accelerator)
+  (let* ((port *acl-port*)
+	 (sheet (mirror->sheet port window))
+	 (control (not (zerop lparam))))
+    (flush-pointer-motion port)
+    (cond ((not control)
+	   ;; User selected a command from the menu bar.
 	   (let* ((frame (pane-frame sheet))
-		  (command (cdr (aref *menu-id->command-table* wloword))))
-	     ;; pr Aug97
-	     (with-slots (clim-internals::disabled-commands) frame
-	       (if (member (car command) clim-internals::disabled-commands)
-		   (win:messagebeep 200)
-		 #+old
-		 (queue-put (slot-value *acl-port* 'event-queue)
-			    (allocate-event 
-			     'presentation-event
-			     :frame frame
-			     :sheet (frame-top-level-sheet frame)
-			     :presentation-type
-			     `(command :command-table ,command-table)
-			     :value command))
-		 (execute-command-in-frame 
-		  frame command)
-		 ))))
-	  (t
-	   (setf (ct:handle-value win:hwnd hwnd) lparam)
-	   ;;mm: for the moment, the following seems superfluous
-	   ;;(setf hwndid (silica::gadget-id->window sheet wloword))
-	   (setf gadget (mirror->sheet *acl-port* hwnd))
-	   (cond ((typep gadget 'silica::mswin-combo-box-pane)
-		  (let ((sheet (mirror->sheet *acl-port* window)))
-		    (when (and sheet (= whiword win:cbn_closeup))
-		      (with-slots (event-queue) *acl-port*
-			(queue-put
-			 event-queue
-			 (multiple-value-bind (left top right bottom)
-			     (mirror-client-region-internal* *acl-port* hwnd window)
-			   (declare (ignore right bottom))
-			   (allocate-event 'silica::window-change-event
-					   :native-x (+ left 1)
-					   :native-y (+ top 1)
-					   :button +pointer-left-button+
-					   :modifier-state 0
-					   :pointer pointer
-					   :sheet sheet
-					   :mswin-control gadget)))))))
-		 ((typep gadget 'silica::mswin-text-edit)
-		  (let ((sheet (mirror->sheet *acl-port* window)))
-		    (when (and sheet (= whiword win:en_killfocus))
-
-		      (with-slots (event-queue) *acl-port*
-					;handle-event
-					;  gadget
-			(multiple-value-bind (left top right bottom)
-			    (mirror-client-region-internal* *acl-port* hwnd window)
-			  (declare (ignore right bottom))
-			  (queue-put event-queue
-				     (allocate-event 
-				      'silica::window-change-event
-				      :native-x (+ left 1)
-				      :native-y (+ top 1)
-				      :button +pointer-left-button+
-				      :modifier-state 0
-				      :pointer pointer
-				      :sheet sheet
-				      :mswin-control gadget)))))))
-		 ((or (not (typep gadget 'silica::hlist-pane))
-		      (= whiword hln_selchange))
-		  (when (typep gadget 'silica::hlist-pane)
-		    (win:setfocus window))
-		  (with-slots (event-queue) *acl-port*
-
-		    (multiple-value-bind (left top right bottom)
-			(mirror-client-region-internal* *acl-port* hwnd window)
-		      (declare (ignore right bottom))
-		      (queue-put event-queue
-				 (allocate-event 
-				  'silica::window-change-event
-				  :native-x (+ left 1)
-				  :native-y (+ top 1)
-				  :button +pointer-left-button+
-				  :modifier-state modifier-state
-				  :pointer pointer
-				  :sheet sheet
-				  :mswin-control gadget))))))))
+		  (ID (loword wparam))
+		  (command (cdr (aref *menu-id->command-table* ID))))
+	     (when command
+	       (with-slots (clim-internals::disabled-commands) frame
+		 (if (member (car command) clim-internals::disabled-commands)
+		     (win:messagebeep 200)
+		   (execute-command-in-frame frame command))))))
+	  (sheet
+	   ;; User clicked on a control.
+	   (let ((gadget (mirror->sheet port lparam)))
+	     (when gadget
+	       (command-event gadget port sheet wparam lparam)))))
     (clear-winproc-result *win-result*)
-    *win-result*))  
+    *win-result*))
+
+(defmethod command-event ((gadget t) port sheet wparam lparam)
+  "Gadget just issued a WM_COMMAND event."
+  (declare (ignore wparam))
+  (let ((pointer (port-pointer port))
+	(modifier-state (make-modifier-state)))
+    (with-slots (event-queue) port
+      (multiple-value-bind (left top right bottom)
+	  (mirror-client-region-internal*
+	   port lparam (sheet-mirror sheet))
+	(declare (ignore right bottom))
+	(queue-put event-queue
+		   (allocate-event 
+		    'silica::window-change-event
+		    :native-x (+ left 1)
+		    :native-y (+ top 1)
+		    :button +pointer-left-button+
+		    :modifier-state modifier-state
+		    :pointer pointer
+		    :sheet sheet
+		    :mswin-control gadget))))))
 
 ;; Process WM_VSCROLL
-(defun onvscroll (window msg wparam lparam)
-  (let* ((type (loword wparam))
+(defun OnVScroll (window msg wparam lparam)
+  (let* ((scrollcode (loword wparam))
 	 (position (hiword wparam))
 	 (hwnd (if (zerop lparam) window lparam)) ; JPM for rfe353
 	 (message (cond ((eql msg win:wm_hscroll) :horizontal)
 			((eql msg win:wm_vscroll) :vertical)))
-	 (flag (cond ((eql msg win:wm_hscroll) win:sb_horz)
-		     ((eql msg win:wm_vscroll) win:sb_vert)))
-	 (sheet (mirror->sheet *acl-port* hwnd)))
+	 (sheet (mirror->sheet *acl-port* hwnd))
+	 (bar (cond ((gadgetp sheet) win:sb_ctl)
+		    ((eql msg win:wm_hscroll) win:sb_horz)
+		    ((eql msg win:wm_vscroll) win:sb_vert)))
+	 (redraw 1))
     (declare (fixnum action position))
+    ;; By convention, scroll bar values should always have a range of 
+    ;; 0 to *win-scroll-grain*.
     (multiple-value-bind (action amount)
-	(cond ((eql type win:sb_lineup)
-	       (win:setScrollPos window flag
-				  (- (win:getScrollPos window flag) 1) 1)
-	       (values :relative-jump -1))
-	      ((eql type win:sb_linedown)
-	       (win:setScrollPos window flag
-				  (+ (win:getScrollPos window flag) 1) 1)
-	       (values :relative-jump +1))
-	      ((eql type win:sb_pageup)
-	       (win:setScrollPos window flag
-				  (- (win:getScrollPos window flag) 1) 1)
-	       (values :screenful -1))
-	      ((eql type win:sb_pagedown)
-	       (win:setScrollPos window flag
-				  (+ (win:getScrollPos window flag) 1) 1)
-	       (values :screenful +1))
-	      ((eql type win:sb_thumbposition)
-	       (win:setScrollPos window flag position 1)
-	       (values :percentage position))
-	      ((and *realtime-scrollbar-tracking*
-		    (eql type win:sb_thumbtrack))
-	       (win:setScrollPos window flag position 1)
-	       (values :percentage position))
-	      ((eql type win:sb_top)
-	       (win:setScrollPos window flag 0 1)
-	       (values :percentage 0))
-	      ((eql type win:sb_bottom)
-	       (win:setScrollPos window flag *win-scroll-grain* 1)
-	       (values :percentage 100)))
+	(case scrollcode
+	  (#.win:sb_bottom
+	   ;; Scroll to lower right
+	   (win:setScrollPos window bar *win-scroll-grain* redraw)
+	   (values :percentage *win-scroll-grain*))
+	  ((#.win:sb_linedown #.win:sb_lineright)
+	   ;; Scroll down/right one unit
+	   (win:setScrollPos window bar
+			     (+ (win:getScrollPos window bar) 1) 
+			     redraw)
+	   (values :relative-jump +1))
+	  ((#.win:sb_lineup #.win:sb_lineleft)
+	   ;; Scroll up/left one unit
+	   (win:setScrollPos window bar
+			     (- (win:getScrollPos window bar) 1) 
+			     redraw)
+	   (values :relative-jump -1))
+	  ((#.win:sb_pagedown #.win:sb_pageright)
+	   ;; Scroll down/right by width of window.
+	   (win:setScrollPos window bar
+			     (+ (win:getScrollPos window bar) 1) 
+			     redraw)
+	   (values :screenful +1))
+	  ((#.win:sb_pageup #.win:sb_pageleft)
+	   ;; Scroll up/left by width of window.
+	   (win:setScrollPos window bar
+			     (- (win:getScrollPos window bar) 1) 
+			     redraw)
+	   (values :screenful -1))
+	  (#.win:sb_thumbposition
+	   ;; Scroll to absolute position.
+	   (win:setScrollPos window bar position redraw)
+	   (values :percentage position))
+	  (#.win:sb_thumbtrack
+	   ;; Scroll to absolute position.
+	   (win:setScrollPos window bar position redraw)
+	   (values :percentage position))
+	  (#.win:sb_top
+	   ;; Scroll to upper left
+	   (win:setScrollPos window bar 0 redraw)
+	   (values :percentage 0))
+	  )
       (when (and action sheet)
 	(with-slots (event-queue) *acl-port*
-	  ;;(queue-put event-queue
 	  (handle-event
 	   sheet
 	   (allocate-event 'silica::scrollbar-event
@@ -471,7 +448,7 @@
 (declaim (special *setting-sheet-mirror-edges*))
 
 ;; Process WM_MOVE
-(defun onmove (window msg wparam lparam)
+(defun OnMove (window msg wparam lparam)
   (let ((sheet (mirror->sheet *acl-port* window)))
     (if (and sheet
 	     (not (eq sheet *setting-sheet-mirror-edges*))
@@ -483,31 +460,25 @@
 	  ;; set return value to 0
 	  (clear-winproc-result *win-result*))
       (setq *win-result* (win:defwindowproc window msg wparam lparam)))
-    *win-result*))  
+    *win-result*))
 
-;; Process WM_GETMINMAXINFO
-(defun ongetminmaxinfo (window msg wparam lparam)
-  #+aclpc ;; pnc Aug97 for clim2bug740
+;; Process WM_SIZE
+(defun OnSize (window msg wparam lparam)
   (let ((sheet (mirror->sheet *acl-port* window)))
-    (if (typep sheet 'acl-top-level-sheet)
-	(let ((min-width (acl-top-min-width sheet))
-	      (min-height (acl-top-min-height sheet)))
-	  ;; someone who knows how to use the pc ff interface should get
-	  ;; rid of all these memrefs! (cim 10/4/96)
-	  (when (and min-width min-height)
-	    (set-measureitemstruct-width-and-height lparam min-width
-						    min-height)
-	    #+ignore
-	    (setf (sys:memref-int lparam 0 24 win:uint) min-width
-		  (sys:memref-int lparam 0 28 win:uint) min-height)
-	    (clear-winproc-result *win-result*)))
-      #+acl86win32
-      (setq *win-result* (win:defwindowproc window msg wparam lparam))
-      #+aclpc
-      (ct:%set-long *win-result* 4 0
-		     (win:defwindowproc window msg wparam lparam)))
-    *win-result*)
-  #-aclpc				; +++ fix this for aclpc +++
+    (if (and sheet
+	     (not (eq sheet *setting-sheet-mirror-edges*))
+	     (not (win:IsIconic window)))
+	(progn
+	  (handle-event
+	   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*))
+
+;; Process WM_GETMINMAXINFO
+(defun OnGetMinMaxInfo (window msg wparam lparam)
   (let ((sheet (mirror->sheet *acl-port* window)))
     (if (typep sheet 'acl-top-level-sheet)
 	(let ((min-width (acl-top-min-width sheet))
@@ -518,15 +489,13 @@
 	    (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*)))
-      #+acl86win32
-      (setq *win-result* (win:defwindowproc window msg wparam lparam))
-      #+aclpc
-      (ct:%set-long *win-result* 4 0
-		     (win:defwindowproc window msg wparam lparam)))
+      (setq *win-result* (win:defwindowproc window msg wparam lparam)))
     *win-result*))
 
 ;; PROCESS EN_UPDATE
-(defun onupdate (window msg wparam lparam)
+(defun OnUpdateText (window msg wparam lparam)
+  ;; An edit control is about to display modified text.
+  ;; Resize the edit control, if necessary.
   (declare (ignore msg wparam lparam))
   (let ((sheet (mirror->sheet *acl-port* window)))
     (when sheet
@@ -556,22 +525,19 @@
 	   (shiftstate (win:getKeyState win:vk_shift))
 	   (controlstate (win:getKeyState win:vk_control))
 	   (metastate (win:getKeyState win:vk_menu)))
-      #+debugg
-      (format *standard-output* 
-	      "caps=~a num=~a shift=~a ctrl=~a meta=~a code=~a~%"
-	      capstate numstate shiftstate controlstate metastate code)
-
       (setf (modstate-control *modstate*)
 	(or (minusp controlstate) (not (zerop (ash controlstate -15)))))
       (setf (modstate-meta *modstate*)
-					; whoops! this was controlstate!?
+	;; whoops! this was controlstate!?
 	(or (minusp metastate) (not (zerop (ash metastate -15)))))
       (setf (modstate-numlock *modstate*)
 	(and (plusp numstate) (zerop (ash numstate -15))))
       (setf (modstate-shift *modstate*)
-	(or (and (or (minusp shiftstate) (not (zerop (ash shiftstate -15))))
+	(or (and (or (minusp shiftstate) 
+		     (not (zerop (ash shiftstate -15))))
 		 (zerop capstate))
-	    (and (not (or (minusp shiftstate) (not (zerop (ash shiftstate -15)))))
+	    (and (not (or (minusp shiftstate) 
+			  (not (zerop (ash shiftstate -15)))))
 		 (and (plusp capstate) (zerop (ash capstate -15)))))))
     (if pass
 	(progn
@@ -609,22 +575,13 @@
 	      (cond ((and (eql msg win:wm_keydown)
 			  (setq command 
 			    (lookup-accelerator frame keysym modstate)))
-		     #+old
-		     (queue-put 
-		      event-queue
-		      (allocate-event 'presentation-event
-				      :frame frame
-				      :sheet (frame-top-level-sheet frame)
-				      :presentation-type
-				      `(command :command-table ,command-table)
-				      :value command))
-		     (execute-command-in-frame
-		      frame command))
+		     (execute-command-in-frame frame command))
 		    ((and (eql msg win:wm_keydown)
 			  (eql keysym :newline)
 			  (find-default-gadget frame))
 		     (activate-default-gadget frame))
 		    (t
+		     (setf (port-modifier-state *acl-port*) modstate)
 		     (queue-put event-queue
 				(allocate-event
 				 (cond ((or (eql msg win:wm_keydown)
@@ -635,9 +592,7 @@
 					'key-release-event))
 				 :key-name keysym
 				 :character char
-				 :modifier-state 
-				 (setf (port-modifier-state *acl-port*)
-				   modstate)
+				 :modifier-state modstate
 				 :sheet sheet))
 		     ;;added this so that port modifier state is always 
 		     ;; updated, even on passed characters. -- KR
@@ -685,18 +640,17 @@
 		      :mswin-control gadget)))
       (clim:beep))))
 
-;; Process WM_BUTTONDOWN
-(defun onbuttondown (window msg wparam lparam)
+;; Process WM_LBUTTONDOWN
+(defun OnButtonDown (window msg wparam lparam)
   ;; added the following so that clicking on a blank area will
   ;; move the focus away from any text-fields and cause their
   ;; value to be correctly updated  - this was copied from the
   ;; handle-event on key-press-event for mswin-text-edit in
   ;; acl-widg (cim 9/17/96)
-  (win:setfocus (win:getactivewindow) #-acl86win32 :static)
-
-  (let ((modifier-state
-	 (windows-mask->modifier-state wparam))
-	(pointer (port-pointer *acl-port*)))
+  (win:setfocus (win:getactivewindow))
+  (let* ((pointer (port-pointer *acl-port*))
+	 (sheet (mirror->sheet *acl-port* window))
+	 (modifier-state (windows-mask->modifier-state wparam)))
     (when pointer
       (flush-pointer-motion *acl-port*)
       (setf (port-modifier-state *acl-port*) modifier-state)
@@ -727,12 +681,49 @@
 				     :button button
 				     :modifier-state modifier-state
 				     :pointer pointer
-				     :sheet (mirror->sheet *acl-port* window)))))))
+				     :sheet sheet))))))
+  (clear-winproc-result *win-result*)
+  *win-result*)
+
+;; Process WM_LBUTTONDBLCLK
+(defun OnButtonDblClk (window msg wparam lparam)
+  ;; A double click will actually generate four events:
+  ;; down, up, dblclk, up.  This function handles the 
+  ;; double click, the other three are handled by OnButtonDown.
+  (win:setfocus (win:getactivewindow))
+  (let* ((pointer (port-pointer *acl-port*))
+	 (sheet (mirror->sheet *acl-port* window))
+	 (modifier-state (windows-mask->modifier-state wparam t)))
+    (when pointer
+      (flush-pointer-motion *acl-port*)
+      (setf (port-modifier-state *acl-port*) modifier-state)
+      (multiple-value-bind (key button)
+	  (cond ((eql msg win:wm_lbuttondblclk)
+		 (values 'pointer-button-press-event
+			 +pointer-left-button+))
+		((eql msg win:wm_mbuttondblclk)
+		 (values 'pointer-button-press-event
+			 +pointer-middle-button+))
+		((eql msg win:wm_rbuttondblclk)
+		 (values 'pointer-button-press-event
+			 +pointer-right-button+)))
+	(with-slots (event-queue) *acl-port*
+	  (queue-put event-queue
+		     (allocate-event key
+				     :native-x (loword lparam)
+				     :native-y (hiword lparam)
+				     :button button
+				     :modifier-state modifier-state
+				     :pointer pointer
+				     :sheet sheet))))))
   (clear-winproc-result *win-result*)
-  *win-result*)  
+  *win-result*)
 
 ;; Process WM_ACTIVATE
-(defun onactivate (window msg wparam lparam)
+(defun OnActivate (window msg wparam lparam)
+  ;; A window or a control is being activated.
+  ;; If user is activating with a mouse click, 
+  ;; OnMouseActivate is also called.
   (declare (ignore msg lparam))
   (let ((sheet (mirror->sheet *acl-port* window))
 	(flag (loword wparam)))
@@ -762,13 +753,26 @@
     *win-result*))
 
 ;; Process WM_INITMENUPOPUP
-(defun oninitmenupopup (window msg wparam lparam)
-  (declare (ignore msg window lparam))
-  (update-menu-item-sensitivities wparam)
-  *win-result*)
+(defun OnInitMenuPopup (window msg wparam lparam)
+  ;; Sent when a drop-down menu or submenu is about to become active.
+  ;; We use it to activate/deactivate menu items and to update
+  ;; menus in response to add/remove menu-item-from-command-table.
+  (declare (ignore msg))
+  (let ((sheet (mirror->sheet *acl-port* window))
+	(system-menu (plusp (hiword lparam)))
+	(index (loword lparam))
+	(menu-handle wparam))
+    (unless system-menu
+      (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*)))
 
 ;; Process WM_NCHITTEST
-(defun onnchittest (window msg wparam lparam)
+(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)))
 
 ;; Allow Windows to provide default message processing.
@@ -777,6 +781,36 @@
   (setq *win-result* (win:defwindowproc window msg wparam lparam))
   *win-result*)
 
+;; Refer to the windows documentation on Tooltip controls.
+;; The message stream needs to be relayed to the tooltip 
+;; control for it to know when and where to display tool tips.
+(ff:defun-c-callable tooltip-relay (window msg wparam lparam)
+  (declare (:convention :stdcall) (:unwind 0)
+	   (special wmsg)
+	   (optimize (safety 0) (speed 3)))
+  (case msg
+    ((#.win:wm_mousemove 
+      #.win:wm_lbuttondown
+      #.win:wm_lbuttonup
+      #.win:wm_rbuttondown
+      #.win:wm_rbuttonup)
+     (let* ((sheet (mirror->sheet *acl-port* window))
+	    (frame (pane-frame sheet))
+	    (top (frame-top-level-sheet frame))
+	    (tt (tooltip-control top))
+	    (ttm_relayevent #.(+ win:wm_user 7))
+	    (relay wmsg))
+       (when tt
+	 (ct:csets win:msg relay
+		   lparam lparam
+		   wparam wparam
+		   message msg
+		   hwnd window)
+	 (or (plusp (win:sendmessage tt TTM_RELAYEVENT 0 relay))
+	     (check-last-error "TTM_RELAYEVENT" :Action :warn))))))
+  #+optional
+  (callnexthookex *next-windows-hook* msg wparam lparam))
+
 (defvar *trace-messages* nil)
 
 ;; CLIM-WIND-PROC
@@ -831,12 +865,14 @@
        (oncommand window msg wparam lparam))
       ((#.win:wm_hscroll #.win:wm_vscroll)
        (onvscroll window msg wparam lparam))
-      ((#.win:wm_move #.win:wm_size)
+      (#.win:wm_move
        (onmove window msg wparam lparam))
+      (#.win:wm_size
+       (onsize window msg wparam lparam))
       (#.win:wm_getminmaxinfo
        (ongetminmaxinfo window msg wparam lparam))
       (#.win:en_update
-       (onupdate window msg wparam lparam))
+       (OnUpdateText window msg wparam lparam))
       ;; character typed
       ((#.win:wm_keydown 
 	#.win:wm_syskeydown
@@ -850,6 +886,10 @@
 	#.win:wm_rbuttonup
 	#.win:wm_mbuttonup)
        (onbuttondown window msg wparam lparam))
+      ((#.win:wm_lbuttondblclk
+	#.win:wm_lbuttondblclk
+	#.win:wm_lbuttondblclk)
+       (onbuttondblclk window msg wparam lparam))
       (#.win:wm_activate
        (onactivate window msg wparam lparam))
       ((#.win:wm_killfocus
@@ -858,7 +898,9 @@
       (#.win:wm_initmenupopup
        (oninitmenupopup window msg wparam lparam))
       (#.win:wm_nchittest
-       (onnchittest window msg wparam lparam))
+       (OnNcHitTest window msg wparam lparam))
+      (#.win:wm_notify
+       (message-default window msg wparam lparam))
       (otherwise
        (message-default window msg wparam lparam)))
     (setf result *win-result*)
@@ -913,11 +955,12 @@
 	    (setf (modstate-numlock *ctlmodstate*)
 	      (and (plusp numstate) (zerop (ash numstate -15))))
 	    (setf (modstate-shift *ctlmodstate*)
-	      (or (and (or (minusp shiftstate) (not (zerop (ash shiftstate -15))))
+	      (or (and (or (minusp shiftstate) 
+			   (not (zerop (ash shiftstate -15))))
 		       (zerop capstate))
-		  (and (not (or (minusp shiftstate) (not (zerop (ash shiftstate -15)))))
-		       (and (plusp capstate) (zerop (ash capstate -15))))))
-	    )
+		  (and (not (or (minusp shiftstate) 
+				(not (zerop (ash shiftstate -15)))))
+		       (and (plusp capstate) (zerop (ash capstate -15)))))))
 
 	  (when (and (or (<= #x30 vk #x5a)(<= #xba vk #xc0)(<= #xdb vk #xdf))
 		     (modstate-shift *ctlmodstate*))
@@ -949,13 +992,9 @@
 	      (if pass
 		  (progn
 		    (setq pass nil)
-		    #+acl86win32
-		    (setq *win-result* (win:callwindowproc std-ctrl-proc-address
-							   window msg wparam lparam))
-		    #+aclpc
-		    (ct:%set-long *win-result* 4 0
-				   (win:callwindowproc std-ctrl-proc-address
-						       window msg wparam lparam))
+		    (setq *win-result* 
+		      (win:callwindowproc std-ctrl-proc-address
+					  window msg wparam lparam))
 		    *win-result*)
 		(progn
 		  ;; We have decided to handle this character ourselves!
@@ -995,6 +1034,8 @@
 (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) 
@@ -1049,6 +1090,9 @@
       (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)))
+    #+not-yet
+    (setf tooltip-relay-address 
+      (init-tooltip-relay tooltip-relay-address #.(make-cstructure 0 16)))
     (setq *clim-initialized* t)))
 
 (defun acl-clim::register-window-class (hcursor)
@@ -1060,28 +1104,35 @@
 	  (icon (win:LoadIcon 0 win:IDI_APPLICATION)) ; (get-clim-icon)
 	  (reg nil))
       (ct:csets win:wndclassex class
-                 win::cbSize (ct:sizeof win:wndclassex)
-                 win::style (logior win:CS_DBLCLKS
-				    win:CS_BYTEALIGNCLIENT
-				    win:CS_BYTEALIGNWINDOW
-				    ;; win:CS_SAVEBITS ; Can we afford this?
-				    ;; win:CS_OWNDC
-				    )
-                 win::lpfnwndproc clim-window-proc-address 
-                 win::cbClsExtra 0
-                 win::cbWndExtra 0
-                 win::hinstance  *hinst*
-                 win::hicon icon 
-                 win::hcursor hcursor
-                 win::hbrbackground (1+ win:color_btnface)
-                 win::lpszmenuname ct:hnull ;*menu-name*
-                 win::lpszclassname (ff:string-to-char* *clim-class*)
-                 win::hIconSm icon)
+		cbSize (ct:sizeof win:wndclassex)
+		style (logior win:CS_DBLCLKS
+			      win:CS_BYTEALIGNCLIENT
+			      win:CS_BYTEALIGNWINDOW
+			      ;; win:CS_SAVEBITS ; Can we afford this?
+			      ;; win:CS_OWNDC
+			      )
+		lpfnwndproc clim-window-proc-address 
+		cbClsExtra 0
+		cbWndExtra 0
+		hinstance  *hinst*
+		hicon icon 
+		hcursor hcursor
+		hbrbackground (1+ win:color_btnface)
+		lpszmenuname ct:hnull	;*menu-name*
+		lpszclassname (ff:string-to-char* *clim-class*)
+		hIconSm icon)
       (setq reg (win:registerclassex class))
       (when (zerop reg)
 	(check-last-error "RegisterClassEx"))
-      (setq *wndclass-registered* t))
-    ))
+      (setq *wndclass-registered* t)
+      (when tooltip-relay-address
+	(setq *next-windows-hook*
+	  (SetWindowsHookEx win:WH_GETMESSAGE 
+			    tooltip-relay-address
+			    0 0))
+	(when (zerop *next-windows-hook*)
+	  (check-last-error "SetWindowsHookEx")))
+      t)))
 
 ;;; "CreateWindowEx"
 ;;;(dword lpctstr lpctstr dword int int int int hwnd hmenu handle lpstr)
@@ -1119,8 +1170,13 @@
     (when pretty
       (setq *win-name* pretty))
     (cond (modal
+	   ;; Accepting-values comes in here.  We need
+	   ;; thickframe, even though that is not normally
+	   ;; used for modal dialog boxes, so that AVV is
+	   ;; sizeable.
 	   (setq winstyle
 	     (logior winstyle
+		     win:ws_thickframe
 		     win:ws_popup
 		     (if parent win:ds_modalframe 0)
 		     win:ds_3dlook
@@ -1234,8 +1290,7 @@
 (defun wait-for-event ()
   (when (prog1
             (win:peekMessage wmsg (ct:null-handle win:hwnd) 0 0
-			     (logior win:PM_NOYIELD win:PM_NOREMOVE)
-			     #+acl86win32x wres)
+			     (logior win:PM_NOYIELD win:PM_NOREMOVE))
 	  (not (and (zerop (hiword wres)) (zerop (loword wres)))))
     t))
 
diff --git a/aclpc/acl-dc.lisp b/aclpc/acl-dc.lisp
index a14f76fe983ce3f00f43b2d7c327c4ce01b27013..97b8c6f0b55993af9150ba9a04229a0cbd80107a 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.6 1998/08/06 23:15:41 layer Exp $
+;; $Id: acl-dc.lisp,v 1.7 1998/10/08 18:36:21 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -72,15 +72,18 @@
 (defvar *created-font* nil)
 (defvar *created-region* nil)
 
+;; Device context information
 (defstruct (dc-image (:predicate nil))
-  (bitmap nil)
-  solid-1-pen
-  ;; Hash table doesn't appear to be needed anymore. JPM Jan 98.
-  (pen-table nil #+obsolete (make-hash-table))
-  brush
-  (rop2 win:r2_copypen)
-  text-color
-  background-color)
+  (bitmapinfo nil)			; colors of unmasked bitmap
+  (bitmap nil)				; bits of unmasked bitmap
+  solid-1-pen				; style, width, and color of lines
+  brush					; color/stipple used to fill polygons
+  (rop2 win:r2_copypen)			; set the foreground mix mode
+  text-color				; foreground color
+  background-color			; background color
+  and-bitmap				; AND part of masked bitmap (monochrome)
+  and-brush                             ; AND part of masked brush (monochrome)
+  )
 
 (defun initialize-dc ()
   (unless (win:iswindow *current-window*)
@@ -223,21 +226,32 @@
        (win:deleteDc ,cdc))))
 
 (defun set-dc-for-drawing (dc image line-style)
+  ;; Note: DASHES may be a list, i.e. (5 2).  CreatePen
+  ;; only supports four dash types, and here we only use
+  ;; one of them.  Complex dash patterns cannot be supported
+  ;; using CreatePen.
   (let* ((dashes (line-style-dashes line-style))
 	 (thickness (max 1 (round (line-style-thickness line-style))))
 	 (code (if dashes (- thickness) thickness))
 	 (brush *null-brush*)
 	 (pen (when (= code 1) (dc-image-solid-1-pen image)))
-	 (rop2 (dc-image-rop2 image)))
+	 (rop2 (dc-image-rop2 image))
+	 (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.
+	;; So render dashes with thickness=1.
+	(setq thickness 1))
+      (when (= rop2 win:r2_xorpen)
+	(setq color #xffffff))		; black
       (setq pen
 	(setq *created-pen*
 	  (createPen (if dashes win:ps_dash win:ps_solid)
 		     thickness
-		     (dc-image-text-color image)))))
+		     color))))
     (selectobject dc pen)
     (if dashes
 	(win:setBkMode dc win:TRANSPARENT)
@@ -246,7 +260,7 @@
     (when rop2 (win:setRop2 dc rop2))
     t))
 
-(defun set-dc-for-filling (dc image)
+(defun set-dc-for-filling (dc image &optional xorg yorg)
   (let ((background-color (dc-image-background-color image))
         (text-color (dc-image-text-color image))
 	(brush (dc-image-brush image))
@@ -255,20 +269,25 @@
     (selectobject dc pen)
     (when background-color
       (cond ((minusp background-color)
+	     ;; This affects brushes created with CreateHatchBrush.
 	     (win:setBkMode dc win:TRANSPARENT))
 	    (t
 	     (win:setBkMode dc win:OPAQUE)
 	     (win:setBkColor dc background-color))))
     (when text-color (win:setTextColor dc text-color))
-    (when brush (selectobject dc brush))
+    (when brush 
+      (when (and xorg yorg)
+	;; Is this working?  JPM.
+	(win:setbrushorgex dc xorg yorg 0))
+      (selectobject dc brush))
     (when rop2  (win:setRop2 dc rop2))
     t))
 
-(defun set-dc-for-ink (dc medium ink line-style)
+(defun set-dc-for-ink (dc medium ink line-style &optional xorg yorg)
   (let ((image (dc-image-for-ink medium ink)))
     (if line-style
       (set-dc-for-drawing dc image line-style)
-      (set-dc-for-filling dc image))))
+      (set-dc-for-filling dc image xorg yorg))))
 
 (defun set-cdc-for-pattern (dc medium ink line-style)
   (declare (ignore line-style))
@@ -310,6 +329,7 @@
 	 (brush (dc-image-brush image))
 	 (pen (dc-image-solid-1-pen image))
 	 (rop2 (dc-image-rop2 image)))
+    (win:setmapmode dc win:MM_TEXT)
     (when font (selectobject dc font))
     (cond ((not background-color)
 	   (win:setBkMode dc win:transparent))
diff --git a/aclpc/acl-frames.lisp b/aclpc/acl-frames.lisp
index 8aa16e10a91decefad6e39ed2c76a8fa954cd3c4..b0107167ab2bd4482e6caef1bd4748c2fdbb41f3 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.7 1998/08/06 23:15:43 layer Exp $
+;; $Id: acl-frames.lisp,v 1.8 1998/10/08 18:36:21 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -90,11 +90,15 @@
    (min-height :accessor acl-top-min-height :initform nil)
    (accelerator-gestures :initform nil :reader top-level-sheet-accelerator-gestures)
    (sheet-thread :initform nil :accessor clim-internals::sheet-thread)
+   (tooltip-control :initform nil :accessor tooltip-control)
    ))
 
-(defun record-accelerator (sheet keysym command)
-  (push (cons keysym command)
-	(slot-value sheet 'accelerator-gestures)))
+(defun record-accelerator (frame keysym command &optional sheet)
+  (unless sheet
+    (setq sheet (frame-top-level-sheet frame)))
+  (pushnew (cons keysym command)
+	   (slot-value sheet 'accelerator-gestures)
+	   :test #'equal))
 
 (defun keysymeql (keysyma keysymb)
   (or (eql keysyma keysymb)
@@ -192,7 +196,7 @@
 ;;; always get repainted in their ungrayed state at the end.  pr Aug97
 
 ;(setf (command-enabled command-name frame) enablep)
-;(win::EnableMenuItem menu menuid (if enablep win:MF_ENABLED win:MF_GRAYED))
+;(win:EnableMenuItem menu menuid (if enablep win:MF_ENABLED win:MF_GRAYED))
 
 (defun keysym->char (keysym)
   (if (typep keysym 'character)
@@ -327,84 +331,172 @@
 				   (gesture-spec-for-mswin keystroke))
 			 newtext))))
 
+(defun make-menu-for-command-table (command-table menuhand frame 
+				    &optional top-level-sheet top-level-p)
+  (unless top-level-sheet
+    (setq top-level-sheet (clim:frame-top-level-sheet frame)))
+  ;; (re)initialize
+  (let ((count (win:getmenuitemcount menuhand)))
+    (when (plusp count)
+      (dotimes (position count)
+	;; Use position = 0 every time because the menu items get
+	;; renumbered each time through this loop.
+	(win:deletemenu menuhand 0 win:MF_BYPOSITION))
+      (win:drawmenubar (sheet-mirror (frame-top-level-sheet frame)))))
+  (setf (gethash menuhand *popup-menu->menu-item-ids*) nil) 
+  (setf (gethash menuhand *popup-menu->command-table*) 
+    (list command-table 
+	  (slot-value (find-command-table command-table)
+		      'clim-internals::menu-tick)))
+  ;; Make the menu
+  (map-over-command-table-menu-items
+   #'(lambda (menu keystroke item)
+       (let* ((type (command-menu-item-type item))
+	      (value (command-menu-item-value item))
+	      (menu-item-available-p 
+	       (or (not (eq type :command))
+		   (command-enabled (car value) frame)))
+	      (menu-item-selected-p nil)
+	      (acckey keystroke)
+	      (flags (logior
+		      win:MF_STRING
+		      (if menu-item-available-p
+			  win:MF_ENABLED win:MF_GRAYED)
+		      (if menu-item-selected-p
+			  win:MF_CHECKED win:MF_UNCHECKED)))
+	      (smflags (logior flags win:MF_POPUP)))
+	 (case type
+	   (:command
+	    (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))
+	      (push menu-item-id (gethash menuhand *popup-menu->menu-item-ids*))))
+	   (:function
+	    (warn ":function not yet implemented in menu bars")
+	    )
+	   (:menu
+	    (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)
+	      (make-menu-for-command-table value submenu-handle frame top-level-sheet)))
+	   (:divider
+	    (win:AppendMenu menuhand
+			     win:MF_SEPARATOR
+			     0
+			     "x")
+	    ))))
+   command-table))
+
 (defun compute-msmenu-bar-pane (frame top command-table)
   (let* ((mirror (sheet-mirror top))
 	 (menu-handle (win:GetMenu mirror))
 	 (command-table
 	  (if (listp command-table) (car command-table) command-table)))
     (when (silica::default-command-table-p command-table)
-	;; command-table arg comes from menu-bar slot of frame
-	;; and may be NIL T=menu-hbox-pane command-table-arg
-      (setq command-table (frame-command-table frame)))
-    (with-look-and-feel-realization ((frame-manager frame) frame)
-      (labels
-	  ((make-command-table-buttons (command-table menuhand top-level)
-	     (let ((menu-item-ids nil))
-	       (map-over-command-table-menu-items
-		#'(lambda (menu keystroke item)
-		    (let* ((type (command-menu-item-type item))
-			   (value (command-menu-item-value item))
-			   (menu-item-available-p 
-			    (or (not (eq type :command))
-				(command-enabled (car value) frame)))
-			   (menu-item-selected-p nil)
-			   (acckey (and (not top-level) keystroke))
-			   (flags (logior
-				   win:MF_STRING
-				   (if menu-item-available-p
-				       win:MF_ENABLED win:MF_GRAYED)
-				   (if menu-item-selected-p
-				       win:MF_CHECKED win:MF_UNCHECKED)))
-			   (smflags (logior flags win:MF_POPUP)))
-		      (case type
-			(:command
-			 (when acckey
-			   (record-accelerator top acckey value))
-			 (let ((menu-item-id
-				(assign-command-menu-item-id value frame)))
-			   (win:AppendMenu
-			    menuhand
-			    flags
-			    menu-item-id
-			    (make-menu-text menu acckey item))
-			   (push menu-item-id menu-item-ids)))
-			(:function
-			 (warn ":function not yet implemented in menu bars")
-			 )
-			(:menu
-			 (let* ((popmenu (win::CreatePopupMenu))
-				(hmenu (ct:handle-value 'win::hmenu popmenu))
-				(menutext (make-menu-text menu acckey item)))
-			   (win::AppendMenu menuhand
-					    smflags
-					    hmenu
-					    menutext)
-			   (setf (gethash hmenu *popup-menu->menu-item-ids*)
-			     (make-command-table-buttons value popmenu nil))))
-			(:divider
-			 (unless top-level
-			   (win::AppendMenu menuhand
-					    win:MF_SEPARATOR
-					    0
-					    "x")
-			   )))))
-		command-table)
-	       menu-item-ids)))
-	(make-command-table-buttons command-table menu-handle t)))))
+      ;; command-table arg comes from menu-bar slot of frame
+      ;; and may be NIL T=menu-hbox-pane command-table-arg
+      (setq command-table (frame-command-table frame)))    
+    (make-menu-for-command-table command-table menu-handle frame top t)))
+
+(defun update-menu-contents (sheet menuhand index)
+  ;; Called just before making a menu active.  If the menu is associated
+  ;; with a command table, make sure to rebuild the menu if the command
+  ;; table has changed recently.  Returns T if the menu was rebuilt.
+  (declare (ignore index))
+  (let* ((frame (pane-frame sheet))
+	 (pair (gethash menuhand *popup-menu->command-table*))
+	 (command-table (first pair))
+	 (tickthen (second pair))
+	 (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)
+      t)))
 
 (defun update-menu-item-sensitivities (hmenu)
+  ;; 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))
 	   (frame (first item))
 	   (command (second item))
 	   (top (frame-top-level-sheet frame))
 	   (mirror (sheet-mirror top))
-	   (menu-handle (win::GetMenu mirror)))
-      (win::EnableMenuItem menu-handle menu-item-id
+	   (menu-handle (win:GetMenu mirror)))
+      (win:EnableMenuItem menu-handle menu-item-id
 			   (if (command-enabled command frame)
 			       win:MF_ENABLED
 			     win:MF_GRAYED)))))
 
+(defmethod initialize-tooltips ((frame standard-application-frame))
+  ;; Create a tooltip control associated with this frame.
+  ;; Note that this control won't do anything unless you
+  ;; set up a message relay to evesdrop on the messages being
+  ;; sent to other controls.
+  (let* ((sheet (frame-top-level-sheet frame))
+	 (tooltip-control (tooltip-control sheet))
+	 (toolinfo (ct:ccallocate toolinfo))
+	 (TTM_ADDTOOL #+ics #.(+ win:wm_user 50) ;; TTM_ADDTOOLW
+		      #-ics #.(+ win:wm_user 4)  ;; TTM_ADDTOOLA
+		      )
+	 (TTM_ACTIVATE #.(+ win:wm_user 1))
+	 (TTF_IDISHWND 1)
+	 (TTS_ALWAYSTIP 1)
+	 (status nil))
+    (unless tooltip-control
+      (win:InitCommonControls)
+      (setq tooltip-control
+	(win:CreateWindow "tooltips_class32"
+			  0
+			  TTS_ALWAYSTIP
+			  win:CW_USEDEFAULT win:CW_USEDEFAULT
+			  win:CW_USEDEFAULT win:CW_USEDEFAULT 
+			  0 0
+			  *hinst* 0))
+      (setf (tooltip-control sheet) tooltip-control)
+      (when (zerop tooltip-control)
+	(check-last-error "CreateWindow" :action :warn)
+	(return-from initialize-tooltips nil))
+      (win:SendMessage tooltip-control TTM_ACTIVATE 1 0)
+      (flet ((tip (s)
+	       ;; I never got tool tips to work, so I didn't
+	       ;; really finish this part.  JPM 8/98.
+	       (ct:csets 
+		toolinfo toolinfo
+		cbsize (ct:sizeof toolinfo)
+		uflags TTF_IDISHWND
+		hwnd (sheet-mirror sheet)
+		uid (sheet-mirror s)
+		;;rect 0
+		hinst *hinst*
+		lpsztext -1 ;(coerce (string (type-of s)) 'simple-string)
+		#+ign
+		(lisp-string-to-scratch-c-string 
+		 (princ-to-string label)))
+	       (setq status
+		 (win:SendMessage tooltip-control
+				  TTM_ADDTOOL 0 toolinfo))
+	       (when (zerop status)
+		 (return-from initialize-tooltips nil))))
+	(declare (dynamic-extent #'tip))
+	(map-over-sheets #'tip sheet)
+	tooltip-control))))
+
 (defmethod redisplay-frame-panes :around ((frame standard-application-frame)
 					  &key force-p)
   (declare (ignore force-p))
@@ -418,6 +510,7 @@
 
 (defmethod run-frame-top-level :before ((frame standard-application-frame)
 					&key &allow-other-keys)
+  (initialize-tooltips frame)
   (let* ((sheet (frame-top-level-sheet frame))
 	 (thread (when sheet (clim-internals::sheet-thread sheet))))
     (unless (eq thread (current-process))
@@ -434,22 +527,22 @@ to be run from another."
   (when (consp command) (setf command (car command)))
   (let* ((top (frame-top-level-sheet frame))
          (mirror (sheet-mirror top))
-         (menu-handle (win::GetMenu mirror))
+         (menu-handle (win:GetMenu mirror))
          (command-id (find-command-menu-item-id command frame))
          (flag win:MF_ENABLED))
     (when menu-handle
-      (win::EnableMenuItem menu-handle command-id flag))))
+      (win:EnableMenuItem menu-handle command-id flag))))
 
 ;;--- Should "gray" the command button, if there is one
 (defmethod note-command-disabled ((framem acl-frame-manager) frame command)
   (when (consp command) (setf command (car command)))
   (let* ((top (frame-top-level-sheet frame))
          (mirror (sheet-mirror top))
-         (menu-handle (win::GetMenu mirror))
+         (menu-handle (win:GetMenu mirror))
          (command-id (find-command-menu-item-id command frame))
          (flag win:MF_GRAYED))
     (when menu-handle
-      (win::EnableMenuItem menu-handle command-id flag))))
+      (win:EnableMenuItem menu-handle command-id flag))))
 
 (defmethod note-frame-enabled :around ((framem acl-frame-manager) frame)
   (call-next-method)
@@ -505,11 +598,11 @@ to be run from another."
         (sheet (frame-top-level-sheet frame)))
     (when name
       (let ((win (sheet-mirror sheet))
-            (cstr (ct::callocate (:char *) :size 256))
+            (cstr (ct:callocate (:char *) :size 256))
 	    (subsize (length name)))
         (dotimes (i subsize)
-          (ct::cset (:char 256) cstr ((fixnum i)) (char-int (char name i))))
-	(ct::cset (:char 256) cstr ((fixnum subsize)) 
+          (ct:cset (:char 256) cstr ((fixnum i)) (char-int (char name i))))
+	(ct:cset (:char 256) cstr ((fixnum subsize)) 
 		  #-aclpc (char-int #\NULL) #+aclpc 0)
 	(or (win:SetWindowText win cstr)
 	    (check-last-error "SetWindowText"))))))
@@ -671,7 +764,11 @@ to be run from another."
     (flet ((print-item (item)
 	     (silica::xlat-newline-return 
 	      (with-output-to-string (stream)
-		(funcall (or printer #'print-menu-item) item 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)
@@ -781,24 +878,26 @@ to be run from another."
 	    (cdr dotted-pair) (code-char 0))))
 
 (eval-when (compile load eval) 
-  (defconstant *scratch-string-length* 256)
+  ;; 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*)))
+  (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)
+	       (setf (ff:fslot-value-c '(:array :char 1)
 					*scratch-c-string*
 					length) 0))
-      (setf (ff::fslot-value-c '(:array char 1) *scratch-c-string*
+      (setf (ff:fslot-value-c '(:array char 1) *scratch-c-string*
 			       i)
 	(char-int (aref lisp-string i))))
     *scratch-c-string*
@@ -894,28 +993,24 @@ to be run from another."
 (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)))
+	   (let ((c-string (ff:allocate-fobject-c '(:array :char 256)))
 		 (length (length string)))
-	     (dotimes (i length (setf (ff::fslot-value-c '(:array :char 1)
+	     (dotimes (i length (setf (ff:fslot-value-c '(:array :char 1)
 							 c-string
 							 length) 0))
 	       (setf (ff:fslot-value-c '(:array char 1) c-string i)
 		 (char-int (aref string i))))
 	     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 
-	    (ff:string-to-char* directory)
-	    #+ignore
-	    (fill-c-string 
-	     (or directory (namestring *default-pathname-defaults*))))
+	   (file-filter-string 
+	    (fill-c-string
+	     (apply #'concatenate 'string
+		    (mapcar #'make-filter-string allowed-types))))
+	   (initial-dir-string (ff:string-to-char* directory))
 	   (prompt-string (fill-c-string prompt)))
       (ct:csets win:openfilename open-file-struct
 		lstructsize (ct:sizeof win:openfilename)
-		hwndowner (or (and stream 
-				   (clim::sheet-mirror stream))
+		hwndowner (or (and stream (sheet-mirror stream))
 			      0)
 		hinstance 0		; no custom dialog
 		lpstrfilter file-filter-string
@@ -924,7 +1019,7 @@ to be run from another."
 		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 256
+		nmaxfile *scratch-string-length*
 		lpstrfiletitle 0 
 		nmaxfiletitle 0
 		lpstrinitialdir initial-dir-string
@@ -937,14 +1032,20 @@ to be run from another."
 		       win:ofn_nochangedir
 		       win:ofn_hidereadonly
 		       )
+		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))))
-	(dolist (c-string (list file-filter-string initial-dir-string prompt-string))
-	  (ff::free-fobject-c c-string))
+	(ff:free-fobject-c file-filter-string)
+	(ff:free-fobject-c initial-dir-string)
+	(ff:free-fobject-c prompt-string)
 	(if result ;; t means no errors and user said "OK"
 	    (if multiple-p
 		(pathnames-from-directory-and-filenames
@@ -962,6 +1063,7 @@ to be run from another."
 						common-dialog-errors))
 				    error-code))))))))))
 
+
 (defun get-directory (sheet title)
   (let* ((info (ct:ccallocate browseinfo)))
     (ct:csets browseinfo info
@@ -980,7 +1082,7 @@ to be run from another."
 
 (defmethod frame-manager-select-file
     ((framem acl-frame-manager)
-     &key (default nil default-p)
+     &key (default nil)
 	  (frame nil frame-p)
 	  (associated-window
 	   (if frame-p
@@ -1005,7 +1107,7 @@ to be run from another."
 		   file-search-proc documentation))
   (unless pattern 
     (setq pattern ""))
-  (when default-p
+  (when (pathnamep default)
     (let ((name (pathname-name default))
 	  (type (pathname-type default))
 	  (dir (pathname-directory default))
@@ -1161,7 +1263,7 @@ to be run from another."
 				  :height 125))
 		     (setf (work-process frame) worker)
 		     (run-frame-top-level frame)))))
-	    (mp:process-wait
+	    (process-wait
 	     "Synchronize"
 	     #'(lambda () 
 		 (and frame 
@@ -1306,7 +1408,7 @@ to be run from another."
   (let ((sheet (frame-top-level-sheet frame)))
     (fix-coordinates x y)
     (or (win:setWindowPos (sheet-mirror sheet)
-			  (ct::null-handle win::hwnd) ; we really want win::HWND_TOP
+			  (ct:null-handle win:hwnd) ; we really want win:HWND_TOP
 			  x y 0 0
 			  (logior win:swp_noactivate
 				  win:swp_nozorder
@@ -1370,12 +1472,14 @@ in a second Lisp process.  This frame cannot be reused."
 	  (when width (maxf width min-width))
 	  (when height (maxf height min-height))))
       (call-next-method frame width height)
-      (let ((wrect (ct::ccallocate win::rect))
+      (let ((wrect (ct:ccallocate win:rect))
 	    (handle (sheet-direct-mirror (frame-top-level-sheet frame))))
-	;;; +++rl don't show the window here
-	;;; the code below makes sure that the frame grows or shrinks
-	;;; when the user resizes the frame window
-	#+ignore (win::showWindow handle win::sw_show)
+	;;; The code below makes sure that the frame grows or shrinks
+	;;; when the user resizes the frame window.
+	;; ----
+	;; Actually, the code below repaints the entire frame,
+	;; which isn't good because, while resizing with the mouse,
+	;; we end up doing this each time the mouse moves.  JPM.
 	(or (win:getClientRect handle wrect)
 	    (acl-clim::check-last-error "GetClientRect"))
 	(or (win:InvalidateRect handle wrect 1)
@@ -1391,17 +1495,17 @@ in a second Lisp process.  This frame cannot be reused."
 
 (defun frame-find-position (frame)
   (when frame 
-    (let* ((wrect (ct::ccallocate win::rect))
+    (let* ((wrect (ct:ccallocate win:rect))
 	   (sheet (frame-top-level-sheet frame))
 	   (handle (when sheet (sheet-mirror sheet))))
       (when handle
-	(win::GetWindowRect handle wrect)
-	(values (ct::cref win::rect wrect win::left) 
-		(ct::cref win::rect wrect win::top))))))
+	(win:GetWindowRect handle wrect)
+	(values (ct:cref win:rect wrect left) 
+		(ct:cref win:rect wrect top))))))
 
 (defun frame-set-position (frame x y)
   (win:setWindowPos (sheet-mirror (frame-top-level-sheet frame))
-     (ct::null-handle win::hwnd) ; we really want win::HWND_TOP
+     (ct:null-handle win:hwnd) ; we really want win:HWND_TOP
      x y 0 0
      (logior win:swp_noactivate
 	     win:swp_nozorder
diff --git a/aclpc/acl-medium.lisp b/aclpc/acl-medium.lisp
index 449b3c5eb5ab7dede826c7969ff78830571771c2..f2b6ddf0f67ef49637d031799e0bc9d2ab1b7fed 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.8 1998/08/06 23:15:44 layer Exp $
+;; $Id: acl-medium.lisp,v 1.9 1998/10/08 18:36:21 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -135,9 +135,9 @@
 (defmethod dc-image-for-ink ((medium acl-medium) (ink (eql +background-ink+)))
   (dc-image-for-ink medium (medium-background medium)))
 
-;; changing the conversion as follows makes CLIM gray colors 1/4, 1/2
-;; and 3/4 gray colors map to the corresponding windows solid system
-;; colors avoiding need for windows to stipple. (cim 10/11/96)
+(defmethod dc-image-for-ink ((medium acl-medium) (ink t))
+  ;; Don't blow out if somebody tries to use a fancy ink like compose-in.
+  (dc-image-for-ink medium (medium-foreground medium)))
 
 (defun color->wincolor (ink &optional medium)
   (declare (optimize (speed 3) (safety 0)))
@@ -150,24 +150,29 @@
 	 ))
   (flet ((convert (x)
 	   (declare (short-float x))
-	   (setq x (float x))		; needed?
-	   (if (< x 1.0)
-	       (values (the fixnum (floor (the short-float (* x #x100)))))
-	     #xff)))
+	   ;; the most common cases should be fast
+	   (let ((v 255.0))
+	     (declare (short-float v))
+	     (cond ((= x 0.0) 0)
+		   ((= x 1.0) #xff)
+		   (t 
+		    (setq v (the short-float (* x v)))
+		    (values (the fixnum (round v))))))))
     (multiple-value-bind (red green blue)
 	(color-rgb ink)
-      (let ((color (dpb (convert blue) (byte 8 16)
-			(dpb (convert green) (byte 8 8)
-			     (convert red)))))
+      (let ((color (dpb (convert (float blue)) (byte 8 16)
+			(dpb (convert (float green)) (byte 8 8)
+			     (convert (float red))))))
 	color))))
 
 (defun wincolor->color (color)
   (if (= color -1)
       +transparent-ink+
     (flet ((convert (x)
-	     (if (eql x #xff)
-		 1.0
-	       (float (/ x 256)))))
+	     ;; the most common cases should be fast
+	     (cond ((= x 0) 0.0)
+		   ((= x #xff) 1.0)
+		   (t (/ x 255.0)))))
       (let ((red (ldb (byte 8 0) color))
 	    (green (ldb (byte 8 8) color))
 	    (blue (ldb (byte 8 16) color)))
@@ -216,8 +221,16 @@
 (defvar *the-dc* nil)			; new just for now, later 
 					; rationalize passing dc
 
+(defun get-bitmapinfo (medium dc-image pixel-map colors)
+  (or (dc-image-bitmapinfo dc-image)
+      (setf (dc-image-bitmapinfo dc-image)
+	(let* ((width (array-dimension pixel-map 1))
+	       (height (array-dimension pixel-map 0)))
+	  (acl-bitmapinfo colors width height medium)))))
+
 ;;;  just for now, later rationalize passing dc
-(defun dc-image-for-multi-color-pattern (medium array designs)
+(defun dc-image-for-multi-color-pattern (medium ink array designs)
+  (declare (ignore ink))
   (let* ((dc-image (copy-dc-image
 		    (slot-value medium 'foreground-dc-image)))
 	 (tink (aref designs 1))
@@ -231,14 +244,19 @@
       (dotimes (j width)
 	(setf (aref into i j) (aref array i j))))
     (setf *bitmap-array* into)
-    (let ((bitmap (get-texture *the-dc* into designs medium)))	
-      (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))
+    (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)))
     dc-image))
 
-(defun dc-image-for-two-color-pattern (medium array designs)
+(defun dc-image-for-transparent-pattern (medium ink array designs)
+  (declare (ignore ink))
   (let* ((dc-image (copy-dc-image
 		    (slot-value medium 'foreground-dc-image)))
 	 (tink (aref designs 1))
@@ -248,15 +266,22 @@
 	 (width (array-dimension array 1))
 	 (height (array-dimension array 0))
 	 (into (make-pixel-map width height 256)))
+    (when (eq tink +transparent-ink+)
+      (rotatef tink bink)
+      (rotatef tcolor bcolor))
     (dotimes (i height)
       (dotimes (j width)
 	(setf (aref into i j) (aref array i j))))
     (setf *bitmap-array* into)
-    (let ((bitmap (get-texture *the-dc* into designs medium)))	
-      (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))
+    (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)))
     dc-image))
 
 (defun byte-align-pixmap (a)
@@ -290,38 +315,93 @@
 	  (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))
+	   (style nil))
+      (unless tcolor (return-from pattern-to-hatchbrush nil))
+      (when (and (> (array-dimension array 0) 1)
+		 (> (array-dimension array 1) 1))
+	(let ((a11 (= (aref array 0 0) tcolor))
+	      (a12 (= (aref array 0 1) tcolor))
+	      (a21 (= (aref array 1 0) tcolor))
+	      (a22 (= (aref array 1 1) tcolor)))
+	  (setq style 
+	    (cond ((and a12 a21 a22) win:HS_CROSS)
+		  ((and a12 a21) win:HS_FDIAGONAL)
+		  ((and a11 a22) win:HS_BDIAGONAL)
+		  ((and a11 a12) win:HS_HORIZONTAL)
+		  ((and a11 a21) win:HS_VERTICAL)))))
+      (unless style (setq style win:HS_FDIAGONAL))
+      (win:createhatchbrush
+       style
+       (color->wincolor (elt designs tcolor))))))
+
 (defmethod dc-image-for-ink ((medium acl-medium) (ink pattern))
-  (multiple-value-bind (array designs) (decode-pattern ink)
-    (cond ((= (length designs) 2)
-	   (setq array (byte-align-pixmap array))
-	   (dc-image-for-two-color-pattern
-	    medium array designs))
-	  ((find +transparent-ink+ designs)
-	   (error 
-	    "Multicolor patterns must not use +transparent-ink+"))
-	  (t
-	   (setq array (byte-align-pixmap array))
-	   (dc-image-for-multi-color-pattern
-	    medium array designs)))))
+  ;; The "pattern" part of the ink is put into the brush.
+  ;; There seems to be a problem with two-color stipples.
+  (let ((cache (port-dc-cache (port medium))))
+    (or (gethash ink cache)
+	(setf (gethash ink cache)
+	  (multiple-value-bind (array designs) (decode-pattern ink)
+	    (cond ((find +transparent-ink+ designs)
+		   ;; This is a terrible hack.
+		   ;; It avoids blowing out, and gives you a transparent stipple,
+		   ;; but it doesn't use the one you request.
+		   (setq array (byte-align-pixmap array))
+		   (let ((dc-image (dc-image-for-transparent-pattern
+				    medium ink array designs)))
+		     (setf (dc-image-brush dc-image) 
+		       (pattern-to-hatchbrush ink))
+		     dc-image))
+		  (t
+		   (setq array (byte-align-pixmap array))
+		   (let ((dc-image (dc-image-for-multi-color-pattern
+				    medium ink array designs)))
+		     ;; win95: creating brushes from patterns larger than
+		     ;; 8x8 is not supported.
+		     (setf (dc-image-brush dc-image)
+		       (win:createPatternBrush (dc-image-bitmap dc-image)))
+		     dc-image))))))))
+
+#|
+does anyone know how to make the bitmaps have transparent
+backgrounds or how to show gif files? i need to make pictures so that
+whats under it will show, but need code in vb3!!! thanks
+
+Joe,
+
+You can do this by creating two pictures, 
+one with white in the transparent area (The Picture)
+and the other with black in the transparent area. (The Mask)
+
+Then use the bitblt API to blit the picture with
+the SRCAND (&h8800c6) flag.
+Then blit the mask in the same location with
+the SRCOR (&hee0086) flag.
+
+This will give you the transparent effect.
+
+This works because ANDing any value with 1 and XORing it with 0
+leaves the original value unchanged. To draw a masked image
+on-screen, Windows first logically ANDs the values in the AND mask
+with the pixel values in the destination DC. This creates a "hole" for
+the image composed of pixels with color values of 0. Then Windows
+XORs the values in the XOR mask to the destination DC, filling in the
+hole left by the AND mask and setting all the 0 pixels to the image
+colors. This is standard stuff described in any entry-level graphics
+programming course. It's also the technique that Windows uses to
+draw icons and mouse cursors on the screen. 
+|#
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink rectangular-tile))
   ;; The only case we handle right now is stipples
-  (let ((pattern (decode-rectangular-tile ink)))
-    (multiple-value-bind (array designs)
-	(decode-pattern pattern)
-      (unless array
-	(error 
-	 "Rectangular tiles other than stipples are not supported yet."))
-      (unless (= (length designs) 2)
-	(error "Only 2-color stipples are currently supported."))
-      (setq array (byte-align-pixmap array))
-      #+old
-      (dc-image-for-ink medium (aref designs 1))
-      (let ((dc-image 
-	     (dc-image-for-two-color-pattern medium array designs)))
-	(setf (dc-image-brush dc-image) 
-	  (win:createPatternBrush (dc-image-bitmap dc-image)))
-	dc-image))))
+  (let ((cache (port-dc-cache (port medium))))
+    (or (gethash ink cache)
+	(setf (gethash ink cache)
+	  ;; The brush of PATTERN is used as the tile.
+	  (dc-image-for-ink medium (decode-rectangular-tile ink))))))
 
 (defun nyi ()
   (error "This NT CLIM operation is NYI (Not Yet Implemented)."))
@@ -457,21 +537,29 @@
 					 left top right bottom)
           (when (< right left) (rotatef right left))
           (when (< bottom top) (rotatef bottom top))
-          (cond ((typep ink 'pattern)
-		 ;; DRAW-PATTERN* ultimately does its drawing here.
-		 ;; BUG: Transparent bits aren't transparent.
-		 (with-compatible-dc (dc cdc)
-		   (let ((width (- right left))
-			 (height (- bottom top))
-			 (*the-dc* dc))
-		     (set-cdc-for-pattern cdc medium ink nil)
-		     (win:bitblt dc left top width height
-				 cdc 0 0 win:srccopy))))
+	  (cond ((typep ink 'pattern)
+		 ;; DRAW-PATTERN* ends up here.  In principle
+		 ;; we could skip this case and rely on the "brush"
+		 ;; to correctly paint the rectangle.  In practice,
+		 ;; this case is needed to correctly render patterns
+		 ;; larger than 8x8, due to limitations of CreatePatternBrush.
+		 (let ((cdc nil)
+		       (dc-image (dc-image-for-ink medium ink)))
+		   ;; Create compatable memory dc
+		   (setq cdc (win:createcompatibledc dc))
+		   ;; select a (Device-Dependent) bitmap into the dc
+		   (win:selectobject cdc (dc-image-bitmap dc-image))
+		   ;; Copy bitmap from memory dc to screen dc
+		   (win:bitblt dc left top (- right left) (- bottom top)
+			       cdc 0 0 win:srccopy)
+		   ;; Delete memory dc
+		   (win:deletedc cdc))
+		 t)
 		(t
-		 ;; dc=0 for acl-pixmap-medium...FIXME.
 		 (let ((*the-dc* dc))
 		   (set-dc-for-ink dc medium ink 
-				   (if filled nil line-style)))
+				   (if filled nil line-style)
+				   left top))
 		 (if filled
 		     (win:rectangle dc left top (1+ right) (1+ bottom))
 		   (win:rectangle dc left top right bottom))))
@@ -518,8 +606,7 @@
 	       (length (length position-seq))
 	       (numpoints (floor length 2))
 	       (extra (and closed line-style))
-	       #-acl86win32 (point-vector (ct:ccallocate (win:point 256)))
-	       #+acl86win32 (point-vector (ct:callocate (:long *) :size 512))) ;  limit?
+	       (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))
@@ -537,17 +624,7 @@
 		  (ct:cset (:long 512) point-vector ((fixnum (* numpoints 2))) x)
 		  (ct:cset (:long 512) point-vector ((fixnum (+ 1 (* numpoints 2)))) y)
 		  ))))
-	  (if (or (typep ink 'pattern) (typep ink 'rectangular-tile))
-	      (if (null line-style)
-		  (let ((*the-dc* dc)
-			(nink ink
-			      #+ignore
-			      (if (typep ink 'pattern)
-				  (make-rectangular-tile ink  8 8)
-				ink)))
-		    (set-dc-for-ink dc medium nink line-style))
-		(set-dc-for-ink dc medium +foreground-ink+ line-style))	    
-	    (set-dc-for-ink dc medium ink line-style))
+	  (set-dc-for-ink dc medium ink line-style)
 	  (if (null line-style)
 	      (win:polygon dc point-vector numpoints)
 	    (win:polyline dc
@@ -579,17 +656,7 @@
 	  (when (null start-angle)
 	    (setq start-angle 0.0
 		  end-angle 2pi))
-	  (if (or (typep ink 'pattern) (typep ink 'rectangular-tile))
-	      (if (null line-style)
-		  (let ((*the-dc* dc)
-			(nink ink
-			      #+ignore
-			      (if (typep ink 'pattern)
-				  (make-rectangular-tile ink  8 8)
-				ink)))
-		    (set-dc-for-ink dc medium nink line-style))
-		(set-dc-for-ink dc medium +foreground-ink+ line-style))	    
-	    (set-dc-for-ink dc medium ink line-style))
+	  (set-dc-for-ink dc medium ink line-style)
 	  (multiple-value-bind (x-radius y-radius)
 	      (cond ((and (= radius-1-dx 0) (= radius-2-dy 0))
 		     (values (abs radius-2-dx) (abs radius-1-dy)))
@@ -791,7 +858,8 @@
 ;;; reading patterns from bitmap files
 
 (defun read-bitmap-file (path &key (format :bitmap) (port (find-port)))
-  (declare (ignore format port))
+  (declare (ignore port))
+  (assert (member format '(:ico :bmp :cur))); give caller reasonable error msg
   (load-pixmap-1 path 0))
 
 (defun load-pixmap-1 (filename index) 
@@ -864,25 +932,25 @@
 	  char2 (code-char (read-byte stream)))
     (cond ((and (eql char1 #\B)
 		(eql char2 #\M))
-	   (setq file-type :pixmap))
+	   (setq file-type :bmp))
 	  ((and (zerop (char-int char1))
 		(zerop (char-int char2)))
 	   (setq word2 (bm-read-word stream))
 	   (cond ((eql word2 1)
-		  (setq file-type :icon))
+		  (setq file-type :ico))
 		 ((eql word2 2)
-		  (setq file-type :cursor)))))
+		  (setq file-type :cur)))))
     (unless file-type
       (error "Object being read is neither a ~
 device-independent bitmap, an icon, nor a cursor."))
     (case file-type
-      (:pixmap
+      (:bmp
        (setq file-size (bm-read-long stream))
        (bm-read-word stream)		; reserved1 = 0
        (bm-read-word stream)		; reserved2 = 0
        (setq image-offset (bm-read-long stream))
        )
-      ((:icon :cursor)
+      ((:ico :cur)
        (setq number-of-resources (bm-read-word stream))
        (setq bytes-into-file 6)
        ;; skip the directory entries up to the requested one.
@@ -912,7 +980,7 @@ device-independent bitmap, an icon, nor a cursor."))
     (setq width (bm-read-long stream)
 	  height (bm-read-long stream))
     ;; for icons & cursors height is pixmap height + mask height
-    (unless (eq file-type :pixmap)
+    (unless (eq file-type :bmp)
       (setq height (floor height 2)))
     (bm-read-word stream) ;; bit-planes = 1
     (setq bits-per-pixel (bm-read-word stream))
@@ -1013,10 +1081,10 @@ device-independent bitmap, an icon, nor a cursor."))
     hotspot-x hotspot-y image-size file-size number-of-resources
     x-pixels-per-meter y-pixels-per-meter
     (case file-type
-      (:pixmap
+      (:bmp
        (values pixmap texture-info nil width
 	       ))
-      ((:icon :cursor)
+      ((:ico :cur)
        (setq file-width (* 4 (ceiling width 32))) ;; <15>
        (setq mask (make-pixel-map
 		   (* 8 file-width) ;; <15>
@@ -1045,10 +1113,12 @@ device-independent bitmap, an icon, nor a cursor."))
 
 (defun make-pattern-from-bitmap-file
     (path &key designs (format :bitmap) (port (find-port)))
+  ;; give reasonable error msg:
+  (assert (member format '(:xbm :xpm :ico :bmp :cur)))
   (if (member format '(:xbm :xpm))
-      (multiple-value-bind (array designs)
+      (multiple-value-bind (array designs-from-file)
 	  (read-xbitmap-file path :format format :port port)
-	(make-pattern array designs))
+	(make-pattern array (or designs designs-from-file)))
     (multiple-value-bind (array texture-info)
 	(read-bitmap-file path :format format :port port)
       (setq array (rotate-and-mirror-bitmap array))
@@ -1130,7 +1200,8 @@ device-independent bitmap, an icon, nor a cursor."))
 	      line))))
 
 (defun read-x11-bitmap-file (fstream)
-  (multiple-value-bind (width height depth left-pad format chars-per-pixel line)
+  (multiple-value-bind (width height depth left-pad format 
+			chars-per-pixel line)
       (get-bitmap-file-properties fstream)
     (declare (ignore format  chars-per-pixel line left-pad))
     (unless (and width height) (error "Not a BITMAP file"))
@@ -1239,6 +1310,7 @@ device-independent bitmap, an icon, nor a cursor."))
 
 (defun read-xbitmap-file (pathname &key (format :xbm) (port (find-port)))
   (declare (type (or pathname string stream) pathname))
+  (assert (member format '(:xbm :xpm)))	; give caller reasonable error msg
   (let ((palette (and port (port-default-palette port))))
     (read-image-file format pathname palette)))
 
@@ -1260,11 +1332,8 @@ device-independent bitmap, an icon, nor a cursor."))
 	(read-bitmap-file path)
       (create-icon array texture mask-array))))
 
-(defun icon-width ()
-   (win:GetSystemMetrics win:SM_CXICON))
-
-(defun icon-height ()
-   (win:GetSystemMetrics win:SM_CYICON))
+(defun icon-width  () (win:GetSystemMetrics win:SM_CXICON))
+(defun icon-height () (win:GetSystemMetrics win:SM_CYICON))
 
 (defun create-icon (pixmap texture-info mask-bitmap) ;; <7>
   (win:CreateIcon *hinst*
@@ -1274,34 +1343,18 @@ device-independent bitmap, an icon, nor a cursor."))
 		  (texture-info-bits-per-pixel texture-info)
 		  mask-bitmap
 		  pixmap))
-		
-
-(in-package :clim-utils)
-
-(setf (gethash "white" clim-utils::*default-named-color-table*)
-      clim:+white+)
-
-(setf (gethash "black" clim-utils::*default-named-color-table*)
-      clim:+black+)
-
-(setf (gethash "red" clim-utils::*default-named-color-table*)
-      clim:+red+)
-
-(setf (gethash "green" clim-utils::*default-named-color-table*)
-      clim:+green+)
-
-(setf (gethash "blue" clim-utils::*default-named-color-table*)
-      clim:+blue+)
-
-(setf (gethash "cyan" clim-utils::*default-named-color-table*)
-      clim:+cyan+)
-
-(setf (gethash "yellow" clim-utils::*default-named-color-table*)
-      clim:+yellow+)
-
-(setf (gethash "magenta" clim-utils::*default-named-color-table*)
-      clim:+magenta+)
-
-
-
 
+(defun initialize-named-colors ()
+  (let ((table clim-utils::*default-named-color-table*))
+    (setf (gethash "white"   table) +white+)
+    (setf (gethash "black"   table) +black+)
+    (setf (gethash "red"     table) +red+)
+    (setf (gethash "green"   table) +green+)
+    (setf (gethash "blue"    table) +blue+)
+    (setf (gethash "cyan"    table) +cyan+)
+    (setf (gethash "yellow"  table) +yellow+)
+    (setf (gethash "magenta" table) +magenta+)
+    table))
+
+(eval-when (load eval)
+  (initialize-named-colors))
diff --git a/aclpc/acl-mirror.lisp b/aclpc/acl-mirror.lisp
index 7670d29b9f1e2a561cb68895a58f0112b7eab260..43864fee6660fdf3db48d98f6da0341f2a365c79 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.6 1998/08/06 23:15:44 layer Exp $
+;; $Id: acl-mirror.lisp,v 1.7 1998/10/08 18:36:21 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -158,14 +158,10 @@
 	     ;;mm: allocate gadget-id per parent
              (setq gadget-id (silica::allocate-gadget-id sheet))
 	     (setq value (slot-value sheet 'silica::value))
-	     (let ((client (gadget-client sheet)))
-	       (setf buttonstyle
-		     (cond
-		          ((typep client 'silica::radio-box-pane)
-			   win:BS_RADIOBUTTON)
-		          ((typep client 'silica::check-box-pane)
-		           win:BS_CHECKBOX)
-		          (t win:BS_CHECKBOX))))))
+	     (setq buttonstyle
+	       (ecase (gadget-indicator-type sheet)
+		 (:one-of win:BS_RADIOBUTTON)
+		 (:some-of win:BS_CHECKBOX)))))
       (when (or (eq control :hbutt) (eq control :hedit))
 	(multiple-value-bind (cwidth cheight)
               (compute-gadget-label-size sheet)
diff --git a/aclpc/acl-port.lisp b/aclpc/acl-port.lisp
index 5c4a63df85824002a84fcd5f1116348dda6a220c..ee3198247f3421fcf87c011abd0e75068b68674a 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.7 1998/08/06 23:15:45 layer Exp $
+;; $Id: acl-port.lisp,v 1.8 1998/10/08 18:36:21 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -298,7 +298,8 @@
 		(:small	     8)
 		(:normal     10)
 		(:large	     12)
-		(:very-large 18)))
+		(:very-large 18)
+		(:huge       24)))
 
 ;;--- hacked to allow text-styles to be specified as lists
 ;;--- there's probably a more efficient way...
@@ -329,6 +330,7 @@
 	    (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"))
@@ -337,13 +339,17 @@
 		  ;;--- some of these specify ugly ugly linedrawn fonts
 		  (otherwise (values (logior win:DEFAULT_PITCH win:FF_DONTCARE)
 				     (string (text-style-family style)))))
-	      (let ((point-size
-		     (let ((size (text-style-size style)))
-		       (typecase size
-			 (number size)
-			 (otherwise
-			  (or (second (assoc size *acl-logical-size-alist*)) 
-			      12))))))
+	      (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 
@@ -362,14 +368,6 @@
   (with-slots (text-style->acl-font-mapping) device
     (or (gethash style text-style->acl-font-mapping)
 	(setf (gethash style text-style->acl-font-mapping)
-	  #+old
-	  (let ((args (silica::device-font-name style)))
-	    (apply #'make-windows-font
-		   (- (round (* (pop args)
-				(slot-value device 'logpixelsy))
-			     72))
-		   args))
-	  #-old
 	  (let ((name (silica::device-font-name style)))
 	    (make-device-font (win:getstockobject name)))))))
 
@@ -390,37 +388,45 @@
 (defun make-system-font ()
   (make-device-font (win:getstockobject win:system_font)))
 
+;; This should be in the WIN package but isn't.
+;; We use it to specify how Windows matches font requests to a
+;; font currently installed on the user's system.  CLIM uses a
+;; TrueType font when the user's system contains multiple fonts of
+;; the same name.  With OUT_DEFAULT_PRECIS, :FIX fonts
+;; were not always mapping to required sizes.  JPM 8/98.
+(defconstant OUT_TT_PRECIS 4)
+
 (defun make-windows-font
     (height &key (width 0) (escapement 0) (orientation 0)
 		 (weight win:FW_NORMAL) 
 		 (italic nil) (underline nil) (strikeout nil)
 		 (charset win:ANSI_CHARSET) 
-		 (output-precision WIN:OUT_DEFAULT_PRECIS) 
+		 (output-precision OUT_TT_PRECIS)
 		 (clip-precision WIN:CLIP_DEFAULT_PRECIS)
 		 (quality win:PROOF_QUALITY) 
 		 (pitch-and-family (logior win:DEFAULT_PITCH win:FF_DONTCARE)) 
 		 (face nil) 
 		 win-font) 
-  (let ((win-font 
-	 (or 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 "")
-			     ))))
-    (when (zerop win-font)
-      (check-last-error "CreateFont"))
-    (make-device-font 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 "")
+		      )))
+  (when (zerop win-font)
+    (check-last-error "CreateFont"))
+  (make-device-font win-font))
 
 (defun make-device-font (win-font) 
   (let ((cw (and *application-frame*
@@ -445,6 +451,7 @@
     (unless (win:iswindow cw) 
       (error "No window found for calculating text font metrics."))
     (with-dc (cw dc)
+      (win:setmapmode dc win:MM_TEXT)
       (selectobject dc win-font)
       (or (win:getTextMetrics dc tmstruct)
 	  (check-last-error "GetTextMetrics"))
@@ -608,7 +615,6 @@
 			        native-x native-y)
         (values x y native-x native-y root-x root-y)))))
 
-
 (defun char->keysym (char)
   (let ((entry (assoc char *keysym-alist*))
         (keysym nil))
@@ -693,14 +699,18 @@
 	    motion-pending nil))))
 
 ;;; Convert a MS Windows shift mask into a CLIM modifier-state
-(defun windows-mask->modifier-state (mask)
-  (if (logtest win:mk_shift mask)
-      (if (logtest win:mk_control mask)
-	  (make-modifier-state :shift :control)
-	  (make-modifier-state :shift))
-      (if (logtest win:mk_control mask)
-	  (make-modifier-state :control)
-	  (make-modifier-state))))
+(defun windows-mask->modifier-state (mask &optional double)
+  (let ((state 
+	 (if (logtest win:mk_shift mask)
+	     (if (logtest win:mk_control mask)
+		 #.(make-modifier-state :shift :control)
+	       #.(make-modifier-state :shift))
+	   (if (logtest win:mk_control mask)
+	       #.(make-modifier-state :control)
+	     #.(make-modifier-state)))))
+    (if double 
+	(logior state #.(make-modifier-state :double))
+      state)))
 
 (defmethod event-handler ((port acl-port) args)
   (declare (ignore args))
@@ -732,6 +742,26 @@
 
 (defvar *clim-pulse-rate* 1.0)		; seconds.
 
+;; Redefine function from utils/processes.lisp.
+(defun clim-utils::process-wait (state function &rest args)
+  (declare (dynamic-extent function args))
+  #+someday
+  (apply #'mp:process-wait state function args)
+  (let ((result nil))
+    (loop
+      ;; 5/28/98 JPM ACL 5.0.beta
+      ;; There seems to be a bug in process-wait (on NT) that
+      ;; it does not run the test function often enough.
+      ;; Lisp will appear to hang until it receives some Windows
+      ;; events, which apparently wake up the scheduler.
+      ;; The workaround is to wake up every so often and
+      ;; run the test function.
+      (when (setq result (apply #'mp:process-wait-with-timeout 
+				state *clim-pulse-rate* 
+				function args))
+	(return result)))))
+  
+
 (defmethod process-next-event ((port acl-port)
 			       &key (timeout nil) 
 				    (wait-function nil)
@@ -754,17 +784,7 @@
 	  (if timeout
 	      (mp:process-wait-with-timeout state timeout
 					    #'wait-for-event)
-	    (loop
-	      ;; 5/28/98 JPM ACL 5.0.beta
-	      ;; There seems to be a bug in process-wait that
-	      ;; it does not run the test function often enough.
-	      ;; The workaround is to wake up every so often and
-	      ;; run the test function.
-	      (when (mp:process-wait-with-timeout 
-		     state *clim-pulse-rate* #'wait-for-event)
-		(return)))
-	    #+someday
-	    (mp:process-wait state #'wait-for-event))))
+	    (process-wait state #'wait-for-event))))
       (cond (event
 	     (distribute-event port event)
 	     t)
diff --git a/aclpc/acl-prel.lisp b/aclpc/acl-prel.lisp
index 0584cba61287d1c115f9d20efbdf0593a66d962c..e585a63b2c73981db5a9875ba40864956c768f65 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.6 1998/08/06 23:15:45 layer Exp $
+;; $Id: acl-prel.lisp,v 1.7 1998/10/08 18:36:21 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -233,6 +233,7 @@
 			       "BUTTON"	; classname
 			       (nstringify nlabel) ; windowname
 			       (logior buttonstyle
+				       win:WS_TABSTOP
 				       win:WS_CHILD
 				       win:WS_CLIPCHILDREN 
 				       win:WS_CLIPSIBLINGS) ; style
@@ -363,23 +364,25 @@
     ;; return values
     (values bmi win:DIB_RGB_COLORS)))
 
-(defmethod get-texture (device-context pixel-map colors medium)
-  (let* ((width (array-dimension pixel-map 1))
-	 (height (array-dimension pixel-map 0))
-	 texture-handle)
-    (multiple-value-bind (bitmapinfo dib-mode)
-	(acl-bitmapinfo colors width height medium)
-      (setq texture-handle
-	(win:CreateDIBitmap
-	 device-context
-	 bitmapinfo 
-	 win:CBM_INIT			; initialize bitmap bits
-	 pixel-map
-	 bitmapinfo 
-	 dib-mode))
-      (when (zerop texture-handle)
-	(check-last-error "CreateDIBitmap"))
-      texture-handle)))
+(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))
+    (when (zerop texture-handle)
+      (check-last-error "CreateDIBitmap"))
+    texture-handle))
 
 ;;; about box support
 
diff --git a/aclpc/acl-scroll.lisp b/aclpc/acl-scroll.lisp
index 8b7bdc593f2a49251b70b46114e1330c022a153b..a10bf1615309759e0e0a9fa77c8345b0cade23d6 100644
--- a/aclpc/acl-scroll.lisp
+++ b/aclpc/acl-scroll.lisp
@@ -1,4 +1,4 @@
-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*-
+;;; -*- Mode: Lisp; Package: silica -*-
 ;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca.
 ;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA  - All rights reserved.
 ;;
@@ -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-scroll.lisp,v 1.6 1998/08/06 23:15:45 layer Exp $
+;; $Id: acl-scroll.lisp,v 1.7 1998/10/08 18:36:21 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -45,24 +45,24 @@
 			 (event silica::scrollbar-event))
   (with-slots (silica::orientation silica::action silica::amount) event
     (assert (eql silica::orientation (gadget-orientation pane)))
-    (multiple-value-bind (min max) (gadget-range* pane)
-      (let ((new
-	     (max min 
-		  (min (- max (scroll-bar-size pane))
-		       (case silica::action
-			 (:relative-jump ; press arrows
-			  (+ (gadget-value pane) 
-			     (* (scroll-bar-size pane) silica::amount)))
-			 (:screenful	; click near thumb
-			  (+ (gadget-value pane) 
-			     (* (scroll-bar-size pane) silica::amount)))
-			 (:percentage	; drag thumb
-			  (+ min
-			     (* (- max min (scroll-bar-size pane)) 
-				(/ silica::amount 
-				   (float acl-clim::*win-scroll-grain*))))))))))
-	#+ignore
-        (setf (gadget-value pane) new)
+    (multiple-value-bind (min) (gadget-range* pane)
+      ;; SCROLL-BAR-SIZE is less than or equal to the range.
+      (let* ((new (case silica::action
+		    (:relative-jump	; press arrows
+		     ;; AMOUNT is plus or minus one
+		     (+ (gadget-value pane) 
+			(* (scroll-bar-size pane) silica::amount)))
+		    (:screenful		; click near thumb
+		     ;; AMOUNT is plus or minus one
+		     (+ (gadget-value pane) 
+			(* (scroll-bar-size pane) silica::amount)))
+		    (:percentage	; drag thumb
+		     ;; AMOUNT is absolute position in the scroll range
+		     ;; (from 0 to *win-scroll-grain*).
+		     (+ min
+			(* (gadget-range pane)
+			   (/ silica::amount 
+			      (float acl-clim::*win-scroll-grain*))))))))
 	(value-changed-callback pane (gadget-client pane) 
 				(gadget-id pane) new)
 	))))
@@ -119,19 +119,19 @@
 (defmethod gadget-supplies-scrolling-p ((sheet acl-clim::acl-text-editor-pane)) t)
 
 (defmethod handle-event ((pane mswin-scroller-pane) 
-						 (event scrollbar-event))
+			 (event scrollbar-event))
   (with-slots (orientation action amount) event
-	(case action
-	  (:relative-jump
-		(case amount
-		  (-1  (scroll-up-line pane orientation))
-		  (1 (scroll-down-line pane orientation))))
-	  (:screenful
-		(case amount
-		  (-1  (scroll-up-page pane orientation))
-		  (1 (scroll-down-page pane orientation))))
-	  (:percentage
-		(scroll-to-position pane orientation amount)))))
+    (case action
+      (:relative-jump
+       (case amount
+	 (-1  (scroll-up-line pane orientation))
+	 (1 (scroll-down-line pane orientation))))
+      (:screenful
+       (case amount
+	 (-1  (scroll-up-page pane orientation))
+	 (1 (scroll-down-page pane orientation))))
+      (:percentage
+       (scroll-to-position pane orientation amount)))))
 
 (defmethod scroll-bar-value-changed-callback
     (sheet (client scroller-pane) id value size)
@@ -196,8 +196,10 @@
 	   (gmax (float (gadget-max-value scroll-bar) 0s0))
 	   (range (- gmax gmin)))
       (declare (type single-float range gmin gmax))
-      (when (and (and current-size (= (the single-float current-size) range))
-		 (= min vmin) (> (- vmax vmin) (- max min)))
+      (when (and current-size
+		 (= (the single-float current-size) range)
+		 (= min vmin)
+		 (> (- vmax vmin) (- max min)))
 	(return-from update-scroll-bar))
       ;; The elevator size in 01 units - calculated from the contents
       (let* ((contents-range (float (- max min) 0.0s0))
@@ -217,33 +219,34 @@
 					  corrected-contents-range))))))))
 	     ;;-- This does not scale by the range
 	     (pos (the single-float
-		    (min 1.0s0 (max 0.0s0
-				    (if (<= corrected-contents-range viewport-range)
-					0.0
-				      (/ (float (- vmin min) 0.0s0) 
-					 ;;--- Uh-oh, the home-grown scroll bars
-					 ;;--- seem to have a different contract
-					 ;;--- from Motif/OpenLook.  Fix them!
-					 #-(or aclpc acl86win32)
-					 (- contents-range viewport-range)
-					 #+(or aclpc acl86win32)
-					 corrected-contents-range)))))))
+		    (min 1.0s0 
+			 (max 0.0s0
+			      (if (<= corrected-contents-range viewport-range)
+				  0.0
+				(/ (float (- vmin min) 0.0s0) 
+				   ;;--- Uh-oh, the home-grown scroll bars
+				   ;;--- seem to have a different contract
+				   ;;--- from Motif/OpenLook.  Fix them!
+				   corrected-contents-range)))))))
 	(declare (type single-float pos size))
 	(unless (and current-size
 		     current-value
 		     (= current-size size)
 		     (= current-value pos))
-	  (let ((scrollinfo-struct (ct:ccallocate win::scrollinfo))
-		(win-id (if (eq orientation :vertical) win:SB_VERT win:SB_HORZ))
-		(win-pos (floor (* pos acl-clim::*win-scroll-grain*)))
-		(win-size (floor (* size (1+ acl-clim::*win-scroll-grain*)))))
-	    (ct:csets win::scrollinfo scrollinfo-struct
-		      win::cbSize (ct:sizeof win::scrollinfo)
-		      win::fMask #.(logior win::SIF_PAGE win::SIF_POS
-					   win::SIF_DISABLENOSCROLL)
-		      win::nPage win-size
-		      win::nPos win-pos)
-	    (win::SetScrollInfo (sheet-mirror scroll-bar) win-id scrollinfo-struct t))
+	  (let ((mirror (sheet-mirror scroll-bar))
+		(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*))))
+	    (ct:csets win:scrollinfo struct
+		      cbSize (ct:sizeof win:scrollinfo)
+		      fMask win:SIF_ALL
+		      nmin 0
+		      nMax acl-clim::*win-scroll-grain*
+		      nPage page
+		      nPos position)
+	    (win:SetScrollInfo mirror bar struct 1))
 	  (case orientation
 	    (:vertical
 	     (setf (scroller-current-vertical-size scroll-bar) size)
@@ -251,9 +254,6 @@
 	    (:horizontal
 	     (setf (scroller-current-horizontal-size scroll-bar) size)
 	     (setf (scroller-current-horizontal-value scroll-bar) pos)))
-	  ;;-- It would be nice if we could do this at the point of scrolling
-	  #+foo (cerror "foo" "pos=~a size=~a min=~a max=~a vmin=~a vmax=~a contents-range=~a"
-			pos size min max vmin vmax contents-range)
 	  )))))
 
 
@@ -281,7 +281,7 @@
 	   (flag (case orientation
 		   (:vertical win:sb_vert)
 		   (:horizontal win:sb_horz)))
-	   (current-value (/ (win::getScrollPos window flag)
+	   (current-value (/ (win:getScrollPos window flag)
 			     (float acl-clim::*win-scroll-grain*)))
 	   (current-size (case orientation
 			   (:horizontal current-horizontal-size)
@@ -293,7 +293,6 @@
 			   (/ (line-scroll-amount scroller-pane orientation :up)
 			      (float contents-range  0.0s0)))))
 	   (new-value (max 0.0 (- current-value line-value))))
-      #+ignore (win::setScrollPos window flag (floor (* new-value *win-scroll-grain*)) 1)
       (scroll-bar-value-changed-callback
        scroller-pane scroller-pane orientation new-value current-size))))
 
@@ -309,7 +308,7 @@
 		   (:vertical win:sb_vert)
 		   (:horizontal win:sb_horz)))
 	   (window (sheet-mirror scroller-pane))
-	   (current-value (/ (win::getScrollPos window flag)
+	   (current-value (/ (win:getScrollPos window flag)
 			     (float acl-clim::*win-scroll-grain*)))
 	   (current-size (case orientation
 			   (:horizontal current-horizontal-size)
@@ -325,35 +324,34 @@
 				 acl-clim::*win-scroll-grain*) ;; max pos
 			      current-size)
 			   (+ current-value line-value))))
-      #+ignore (win::setScrollPos window flag (floor (* 100 new-value)) 1)
       (scroll-bar-value-changed-callback
        scroller-pane scroller-pane orientation new-value current-size)
       )))
 
 (defmethod scroll-up-page ((scroller-pane mswin-scroller-pane) orientation)
   (with-slots (current-vertical-size current-vertical-value
-									 current-horizontal-size current-horizontal-value
-									 viewport contents) scroller-pane
-	(let* ((flag (case orientation
-				   (:vertical win:sb_vert)
-				   (:horizontal win:sb_horz)))
-		   (window (sheet-mirror scroller-pane))
-		   (current-value (/ (win::getScrollPos window flag)
-				     (float acl-clim::*win-scroll-grain*)))
-		   (current-size (case orientation
-						   (:horizontal current-horizontal-size)
-						   (:vertical  current-vertical-size)))
-		   (contents-range (contents-range scroller-pane orientation))
-		   (viewport-range (bounding-rectangle-max-y viewport))
-		   new-value)
-	  (if (zerop contents-range)
-		  (setq new-value current-value)
-		  (let ((page-value (the single-float 
-								 (/ viewport-range (float contents-range 0.0s0)))))
-			(setq new-value (max 0.0 (- current-value page-value)))))
-	  #+ignore (win::setScrollPos window flag (floor (* 100 new-value)) 1)
-	  (scroll-bar-value-changed-callback
-		scroller-pane scroller-pane orientation new-value current-size))))
+	       current-horizontal-size current-horizontal-value
+	       viewport contents) scroller-pane
+    (let* ((flag (case orientation
+		   (:vertical win:sb_vert)
+		   (:horizontal win:sb_horz)))
+	   (window (sheet-mirror scroller-pane))
+	   (current-value (/ (win:getScrollPos window flag)
+			     (float acl-clim::*win-scroll-grain*)))
+	   (current-size (case orientation
+			   (:horizontal current-horizontal-size)
+			   (:vertical  current-vertical-size)))
+	   (contents-range (contents-range scroller-pane orientation))
+	   (viewport-range (bounding-rectangle-max-y viewport))
+	   new-value)
+      (if (zerop contents-range)
+	  (setq new-value current-value)
+	(let ((page-value 
+	       (the single-float 
+		 (/ viewport-range (float contents-range 0.0s0)))))
+	  (setq new-value (max 0.0 (- current-value page-value)))))
+      (scroll-bar-value-changed-callback
+       scroller-pane scroller-pane orientation new-value current-size))))
 
 (defmethod scroll-down-page  ((scroller-pane mswin-scroller-pane) orientation)
   (with-slots (current-vertical-size current-vertical-value
@@ -363,7 +361,7 @@
 		   (:vertical win:sb_vert)
 		   (:horizontal win:sb_horz)))
 	   (window (sheet-mirror scroller-pane))
-	   (current-value (/ (win::getScrollPos window flag)
+	   (current-value (/ (win:getScrollPos window flag)
 			     (float acl-clim::*win-scroll-grain*)))
 	   (current-size (case orientation
 			   (:horizontal current-horizontal-size)
@@ -379,7 +377,6 @@
 				     acl-clim::*win-scroll-grain*)
 				  current-size)
 			       (+ current-value page-value)))))
-      #+ignore (win::setScrollPos window flag (floor (* 100 new-value)) 1)
       (scroll-bar-value-changed-callback
        scroller-pane scroller-pane orientation new-value current-size))))
 
@@ -388,19 +385,9 @@
   (with-slots (current-vertical-size current-vertical-value
 	       current-horizontal-size current-horizontal-value
 	       viewport contents) scroller-pane
-    (let* (#+ignore
-	   (flag (case orientation
-		   (:vertical win:sb_vert)
-		   (:horizontal win:sb_horz)))
-	   #+ignore
-	   (current-value (case orientation
-			    (:horizontal current-horizontal-value)
-			    (:vertical  current-vertical-value)))
-	   (current-size (case orientation
+    (let* ((current-size (case orientation
 			   (:horizontal current-horizontal-size)
 			   (:vertical  current-vertical-size)))
-	   ;;(contents-range (contents-range scroller-pane orientation))
-	   ;;(viewport-range (bounding-rectangle-max-y viewport))
 	   (new-value (/ pos (float acl-clim::*win-scroll-grain*))))
       (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 c9ae0754a738bd5c87b4f16087e2f67dae502f14..b896e3f50d7aa9703a87e48cd9fa7906a660b708 100644
--- a/aclpc/acl-widget.lisp
+++ b/aclpc/acl-widget.lisp
@@ -1,4 +1,4 @@
-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*-
+;;; -*- Mode: Lisp; Package: silica; -*-
 ;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca.
 ;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA  - All rights reserved.
 ;;
@@ -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.9 1998/08/06 23:15:45 layer Exp $
+;; $Id: acl-widget.lisp,v 1.10 1998/10/08 18:36:21 layer Exp $
 
 #|****************************************************************************
 *                                                                            *
@@ -95,7 +95,7 @@
 		   (delete new (gadget-value pane))
 		 (push new (gadget-value pane)))))))))))
 
-(defmethod (setf gadget-value) :after
+(defmethod (setf gadget-value) :before
 	   (value (pane hlist-pane) &key invoke-callback)
   (declare (ignore invoke-callback))
   (with-slots (mode items value-key test) pane
@@ -120,12 +120,7 @@
 	    (when i 
 	      (win:sendMessage 
 	       hwnd win:LB_SETCURSEL i 0))))
-
-	;; check out compute-list-pane-selected-items
-	;; in the unix code to see how to do this 
-	;; (cim 9/25/96)
-	#+ignore
-	(win:sendMessage hwnd win:LB_settopindex value 0)))))
+	))))
 
 (defmethod handle-event :after ((pane hlist-pane) (event pointer-event))
   (deallocate-event event))
@@ -173,6 +168,27 @@
         :width (+ name-width 20)
         :height name-height))))
 
+;;; When items are set in an hlist-pane the  mirror must be
+;;; made to update its appearance appropriately.
+(defmethod (setf set-gadget-items) :before (items (pane hlist-pane))
+  (with-slots (name-key mirror) pane
+    (when mirror
+      (win:SendMessage mirror win:LB_RESETCONTENT 0 0)
+      (dolist (item items)
+	(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)))
+      (win:InvalidateRect mirror ct:hnull win:true)))) ;; make sure it updates
+
+(defmethod acl-clim::command-event :around ((gadget silica::hlist-pane) 
+					    port sheet wparam lparam)
+  (let ((notifycode (acl-clim::hiword wparam)))
+    (when (= notifycode win:lbn_selchange)
+      ;; Selection in list box is about to change.
+      (win:setfocus (sheet-mirror sheet))
+      (call-next-method gadget port sheet wparam lparam))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; mswin-text-edit
 
@@ -362,20 +378,14 @@
     cstr))
 
 ;; added back with mods by pr 1May97 (from whence?) -tjm 23May97
-(defmethod (setf gadget-value) :after (str (pane mswin-text-edit) &key invoke-callback)
+(defmethod (setf gadget-value) :before (str (pane mswin-text-edit) 
+					&key invoke-callback)
   (declare (ignore invoke-callback))
   (with-slots (mirror value) pane
     (setq value str)			; Moved outside conditional - smh 26Nov96
     (when mirror
       (win:setWindowText
-       mirror (xlat-newline-return str))
-      ;; I wonder whether this avoidance of the callback is really correct,
-      ;; or whether it was a quick workaround for bad control structure elsewhere.
-      ;; It could be causing some of our ds problems, but I'm not changing it
-      ;; right now.  Also, should it be moved outside the conditional? -smh 26Nov96
-      (when nil				;+++ invoke-callback
-	(value-changed-callback pane
-				(gadget-client pane) (gadget-id pane) str)))))
+       mirror (xlat-newline-return str)))))
 
 (defmethod gadget-value ((pane mswin-text-edit))
   (with-slots (mirror value) pane
@@ -394,6 +404,13 @@
       ;;right -- K. Reti
       (values value (if (listp value) (length value) 0)))))
 
+(defmethod acl-clim::command-event :around ((gadget silica::mswin-text-edit) 
+					    port sheet wparam lparam)
+  (let ((notifycode (acl-clim::hiword wparam)))
+    (when (= notifycode win:en_killfocus)
+      ;; Edit control just lost keyboard focus.
+      (call-next-method gadget port sheet wparam lparam))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; buttons
 
@@ -542,7 +559,6 @@
     ((pixmap :initform nil)
      (raster-op :initform *default-picture-button-op* :initarg :raster-op))
   (:default-initargs :label nil
-		     :indicator-type ':one-of
 		     ;; We no longer want this as it overrides the the
 		     ;; system font returned by get-sheet-resources
 		     ;; in acl-medi.lisp (cim 10/12/96)
@@ -600,40 +616,29 @@
 			 ;; with bad redirection of pointer-events -
 			 ;; see comment in silica/event.lisp (cim 9/17/96)
 			 (event window-change-event))
-  ;; removed the armed test that came from db-button.lisp - not
-  ;; applicable for built in gadgets - check for other gadget classes
-  ;; (cim 9/17/96) 
-  (setf (gadget-value pane :invoke-callback t) (not (gadget-value pane))))
+  (setf (gadget-value pane :invoke-callback t)
+    (or (eq (gadget-indicator-type pane) :one-of)
+	(not (gadget-value pane)))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; option panes
-;;;
-;;; mswin option panes have been replced by mswin-combo-box
-
-;;; clim\db-list
-(defclass acl-clim::winwidget-mixin () ())
+(defmethod (setf gadget-indicator-type) :before (value (pane hbutton-pane))
+  (declare (ignore value))
+  (error "Cannot change the indicator-type of a checkbox at this time"))
 
 ;;; When an hbutton is set, update its checkmark appropriately.
-(defmethod (setf gadget-value) :after (value (pane hbutton-pane) 
+(defmethod (setf gadget-value) :before (value (pane hbutton-pane) 
 				       &key invoke-callback)
   (declare (ignore invoke-callback))
   (with-slots (mirror) pane
     (when mirror
-      ;;(break "About to set value of ~a to ~a." pane value)
       (win:sendmessage mirror win:BM_SETCHECK (if value 1 0) 0))))
 
-;;; When items are set in an hlist-pane the  mirror must be
-;;; made to update its appearance appropriately.
-(defmethod (setf set-gadget-items) :after (items (pane hlist-pane))
-  (with-slots (name-key mirror) pane
-    (when mirror
-      (win:SendMessage mirror win:LB_RESETCONTENT 0 0)
-      (dolist (item items)
-	(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)))
-      (win:InvalidateRect mirror ct:hnull win:true)))) ;; make sure it updates
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; option panes
+;;;
+;;; mswin option panes have been replced by mswin-combo-box
+
+;;; clim\db-list
+(defclass acl-clim::winwidget-mixin () ())
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Combo Box
@@ -667,7 +672,7 @@
         (setf index (win:sendmessage mirror win:cb_getcursel 0 0))
         (setf (gadget-value pane :invoke-callback t) (funcall value-key (elt items index)))))))
 
-(defmethod (setf gadget-value) :after
+(defmethod (setf gadget-value) :before
 	   (value (pane mswin-combo-box-pane) &key invoke-callback)
   (declare (ignore invoke-callback))
   (with-slots (mode items value-key test) pane
@@ -697,6 +702,13 @@
        :width (+ name-width 20)
        :height (+ name-height 7)))))
 
+(defmethod acl-clim::command-event ((gadget silica::mswin-combo-box-pane) 
+				    port sheet wparam lparam)
+  (let ((notifycode (acl-clim::hiword wparam)))
+    (when (= notifycode win:cbn_closeup)
+      ;; List box of a combo box has been closed.
+      (call-next-method gadget port sheet wparam lparam))))
+
 (in-package :acl-clim)
 
 ;;; This controls the space allocated to a combo-box control.  Space is
@@ -889,48 +901,42 @@
 				     line-increment
 				     (page-increment slider-size))
   (declare (ignore page-increment line-increment))
-  (let ((mirror (sheet-direct-mirror sb)))
+  (let ((mirror (sheet-direct-mirror sb))
+	(range (gadget-range sb)))
     (when mirror
       (unless slider-size (setq slider-size (scroll-bar-size sb)))
+      (setq slider-size (min slider-size range)); sanity check
       (unless value (setq value (gadget-value sb)))
       (multiple-value-bind (min max) (gadget-range* sb)
-	(let* ((scrollinfo-struct (ct:ccallocate win:scrollinfo))
-	       (win-id win:SB_CTL)	; a control (decoupled from other panes)
-	       (range (- max min))
-	       (win-size (floor (* acl-clim::*win-scroll-grain* 
-				   ;; Don't divide zero by zero
-				   (if (zerop slider-size) slider-size
-				     (/ slider-size (+ range slider-size))))))
-	       (win-pos (floor (* (- acl-clim::*win-scroll-grain* 
-				     slider-size)
-				  ;; Don't divide zero by zero
-				  (if (= value min) 0
-				    (/ (- value min) (- range slider-size)))))))
+	(setf value (max min (min max value))); sanity check
+	(decf value min)
+	(let* ((struct (ct:ccallocate win:scrollinfo))
+	       (page
+		(floor 
+		 (* acl-clim::*win-scroll-grain* 
+		    (if (zerop slider-size) 
+			slider-size (/ slider-size range)))))
+	       (position
+		(floor
+		 (* acl-clim::*win-scroll-grain* 
+		    (if (zerop value) value (/ value range))))))
 	  (ct:csets
-	   win:scrollinfo scrollinfo-struct
-	   win::cbSize (ct:sizeof win:scrollinfo)
-	   win::fMask #.(logior 
-			 win:SIF_PAGE 
-			 win:SIF_POS
-			 1		;win:SIF_RANGE
-			 win:SIF_DISABLENOSCROLL)
-	   win::nMin 0
-	   win::nMax acl-clim::*win-scroll-grain*
-	   win::nPage win-size
-	   win::nPos win-pos)
-	  (win:SetScrollInfo (sheet-mirror sb) win-id scrollinfo-struct t))))))
-
-(defmethod (setf gadget-value) :after
+	   win:scrollinfo struct
+	   cbSize (ct:sizeof win:scrollinfo)
+	   fMask win:SIF_ALL
+	   nMin 0
+	   nMax acl-clim::*win-scroll-grain*
+	   nPage page
+	   nPos position)
+	  (win:SetScrollInfo mirror win:SB_CTL struct 1))))))
+
+(defmethod (setf gadget-value) :before
 	   (nv (gadget mswin-scroll-bar) &key invoke-callback)
   (declare (ignore invoke-callback))
-  (let ((mirror (sheet-direct-mirror gadget)))
-    (when mirror
-      (change-scroll-bar-values gadget :value nv))))
+  (change-scroll-bar-values gadget :value nv))
 
-(defmethod (setf scroll-bar-size) :after (nv (gadget mswin-scroll-bar))
-  (let ((mirror (sheet-direct-mirror gadget)))
-    (when mirror
-       (change-scroll-bar-values gadget :slider-size nv))))
+(defmethod (setf scroll-bar-size) :before (nv (gadget mswin-scroll-bar))
+  (change-scroll-bar-values gadget :slider-size nv))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; pull-down-menu
diff --git a/aclpc/winwidgh.lisp b/aclpc/winwidgh.lisp
index f54bb02c9cfa1f4efd14025cc9d64d0e730e94c9..ad37226b0756655113acc3047dedcf7a15338192 100644
--- a/aclpc/winwidgh.lisp
+++ b/aclpc/winwidgh.lisp
@@ -1,4 +1,4 @@
-;;; -*- Package: win; mode: Common-Lisp -*-
+;;; -*- Package: acl-clim; mode: Common-Lisp -*-
 ;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca.
 ;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA  - All rights reserved.
 ;;
@@ -16,13 +16,12 @@
 ;; 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.3 1998/08/06 23:15:46 layer Exp $
+;; $Id: winwidgh.lisp,v 1.4 1998/10/08 18:36:21 layer Exp $
 
 (in-package :acl-clim)
 
 ;; These seem to be missing from winapi-dev
 (defconstant LBS_DISABLENOSCROLL #x1000)
-(defconstant HLN_SELCHANGE #x1)
 (defconstant CB_SETTOPINDEX #x015c)
 
 (ff:def-foreign-type browseinfo
@@ -35,6 +34,16 @@
 	     (lparam win:lparam)
 	     (iImage :int)))
 
+(ff:def-foreign-type toolinfo
+    (:struct (cbsize win:uint)
+	     (uflags win:uint)
+	     (hwnd win:hwnd)
+	     (uid win:uint)
+	     (rect win:rect)
+	     (hinst win:hinstance)
+	     (lpsztext win:lpstr)
+	     (lparam win:lparam)))
+
 (ff:def-foreign-call (SHBrowseForFolder "SHBrowseForFolder")
     ((info browseinfo))
   :returning :int
@@ -74,3 +83,11 @@
   :arg-checking nil
   :call-direct t
   :returning :int)
+
+(ff:def-foreign-call (setwindowshookex "SetWindowsHookExA")
+    ((a :int) (b :int) (c :int) (d :int))
+  :returning :int)
+
+(ff:def-foreign-call (callnexthookex "CallNextHookExA")
+    ((a :int) (b :int) (c :int) (d :int))
+  :returning :int)
diff --git a/clim/frames.lisp b/clim/frames.lisp
index fdcd458376426a5f3bd8c1c20608c20635dcbc0d..b3298ec407ec0ea3be9d5316d7be15720a22e786 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.90 1998/08/06 23:15:56 layer Exp $
+;; $Id: frames.lisp,v 1.91 1998/10/08 18:36:22 layer Exp $
 
 (in-package :clim-internals)
 
@@ -1550,7 +1550,8 @@
     (:control "c")
     (:meta "m")
     (:super "s")
-    (:hyper "h")))
+    (:hyper "h")
+    (:double "dbl")))
 
 (defun frame-document-highlighted-presentation-1
        (frame presentation input-context window x y stream)
@@ -1569,11 +1570,11 @@
              (*print-pretty* nil))
         (flet ((document-translator (translator presentation context-type
                                      button-names separator)
-                 ;; Assumes 5 modifier keys and the reverse ordering of *MODIFIER-KEYS*
+                 ;; Assumes 6 modifier keys and the reverse ordering of *MODIFIER-KEYS*
                  (let ((bit #o20)
-                       (shift-name '(:hyper :super :meta :control :shift)))
+                       (shift-name '(:double :hyper :super :meta :control :shift)))
                    (declare (type fixnum bit))
-                   (repeat 5                ;length of shift-name
+                   (repeat 6                ;length of shift-name
                            (unless (zerop (logand bit modifier-state))
                              (write-string
                               (frame-modifier-key-documentation frame
diff --git a/clim/gestures.lisp b/clim/gestures.lisp
index b9aefd3cfc482ed4af6f06824e28ac8853046e81..d9818fbd021f9d1363a0d6f118dfce3a8b813e96 100644
--- a/clim/gestures.lisp
+++ b/clim/gestures.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: gestures.lisp,v 1.27 1998/08/06 23:15:56 layer Exp $
+;; $Id: gestures.lisp,v 1.28 1998/10/08 18:36:22 layer Exp $
 
 (in-package :clim-internals)
 
@@ -27,7 +27,7 @@
 ;;; pointer gesture, e.g., Shift-Left.
 
 ;;; For now, we are making a few assumptions.
-;;; 1) The set of possible modifier bits is :CONTROL, :SHIFT, :META, :SUPER, and :HYPER,
+;;; 1) The set of possible modifier bits is :CONTROL, :SHIFT, :META, :SUPER, :HYPER, :DOUBLE
 ;;;    as per CLtL.
 ;;; 2) The set of possible "mouse buttons" is :LEFT, :MIDDLE, and :RIGHT.
 
@@ -51,7 +51,7 @@
 (defun make-modifier-state (&rest modifiers)
   (declare (dynamic-extent modifiers))
   (assert (every #'(lambda (x) (find x *modifier-keys*)) modifiers) (modifiers)
-          "~S is not a subset of ~S" modifiers '(:shift :control :meta :super :hyper))
+          "~S is not a subset of ~S" modifiers '(:shift :control :meta :super :hyper :double))
   (let ((state 0))
     (dolist (name modifiers)
       (let ((bit (modifier-key-index name)))
@@ -417,12 +417,14 @@
                      (:super   "s-")
                      (:meta    "m-")
                      (:control "c-")
-                     (:shift   "sh-"))
+                     (:shift   "sh-")
+		     (:double  "dbl-"))
                    '((:hyper   "hyper-")
                      (:super   "super-")
                      (:meta    "meta-")
                      (:control "control-")
-                     (:shift   "shift-")))))
+                     (:shift   "shift-")
+		     (:double "double-")))))
     (dolist (shift alist)
       (when (member (first shift) (rest gesture-spec))
         (princ (second shift) stream)))
@@ -450,7 +452,8 @@
                     (:control "c")
                     (:meta "m")
                     (:super "s")
-                    (:hyper "h")))
+                    (:hyper "h")
+		    (:double "dbl")))
               (format stream "~:(~A-~)" name))))))))
 
 
diff --git a/clim/output-protocol.lisp b/clim/output-protocol.lisp
index 0c2b46203c93f8fe939241b594e62aab173196d2..ec4523cb45e81cd24cc9a627022db587b22a24e6 100644
--- a/clim/output-protocol.lisp
+++ b/clim/output-protocol.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: output-protocol.lisp,v 1.48 1998/08/06 23:16:01 layer Exp $
+;; $Id: output-protocol.lisp,v 1.49 1998/10/08 18:36:22 layer Exp $
 
 (in-package :clim-internals)
 
@@ -81,7 +81,10 @@
     (setf (slot-value stream 'text-margin) text-margin)))
 
 ;;--- I sure don't like having to do this to make string streams work
-(defmethod stream-default-view ((stream t)) +textual-view+)
+;; JPM: added setf method to help PC port. 8/98.
+(defvar *stream-default-view* +textual-view+)
+(defmethod stream-default-view ((stream t)) *stream-default-view*)
+(defmethod (setf stream-default-view) (new (stream t)) (setq *stream-default-view* new))
 
 (defmethod stream-vertical-spacing ((stream t))
   (coordinate 0))
diff --git a/silica/classes.lisp b/silica/classes.lisp
index bfc5ac283a5cd0732486ec6d37310ab77b267b24..c7fa7d0fb81fd138795deb090d78194eb83a0637 100644
--- a/silica/classes.lisp
+++ b/silica/classes.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: classes.lisp,v 1.41 1998/08/06 23:16:56 layer Exp $
+;; $Id: classes.lisp,v 1.42 1998/10/08 18:36:24 layer Exp $
 
 (in-package :silica)
 
@@ -267,10 +267,16 @@
 (defconstant +super-key+   (ash 1 3))
 (defconstant +hyper-key+   (ash 1 4))
 
+;; Of course there is no "double" key. I am choosing to
+;; represent a double-click event in one of the unused
+;; bits of the modifier mask.  JPM 8/98.
+(defconstant +double-key+  (ash 1 5))
+
 ;; The order of this must match the values above
-(defconstant *modifier-keys* '#(:shift :control :meta :super :hyper))
+(defconstant *modifier-keys* '#(:shift :control :meta :super :hyper :double))
 
 (deftype shift-keysym   () '(member :left-shift :right-shift))
+(deftype double-keysym  () '(member :left-double :right-double))
 (deftype control-keysym () '(member :left-control :right-control))
 (deftype meta-keysym    () '(member :left-meta :right-meta))
 (deftype super-keysym   () '(member :left-super :right-super))
@@ -278,4 +284,5 @@
 (deftype lock-keysym    () '(member :caps-lock :shift-lock :mode-lock))
 
 (deftype modifier-keysym ()
-  '(or shift-keysym control-keysym meta-keysym super-keysym hyper-keysym))
+  '(or shift-keysym control-keysym meta-keysym 
+    super-keysym hyper-keysym double-keysym))
diff --git a/silica/db-label.lisp b/silica/db-label.lisp
index 4a099262906690b3cdbbdaceeaf102ff94ad4a9b..464747cda79743e130b1d74ca49be2003354d89e 100644
--- a/silica/db-label.lisp
+++ b/silica/db-label.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: db-label.lisp,v 1.6 1998/08/06 23:16:57 layer Exp $
+;; $Id: db-label.lisp,v 1.7 1998/10/08 18:36:24 layer Exp $
 
 ;;; This file also exists in clim2/homegrown. The homegrown directory
 ;;; contains files to implement CLIM's generic gadgets. Native backends
@@ -44,9 +44,8 @@
 (defmethod handle-repaint ((pane generic-label-pane) region)
   (declare (ignore region))                        ;not worth checking
   (with-sheet-medium (medium pane)
-    (window-clear medium)
     (with-bounding-rectangle* (left top right bottom) (sheet-region pane)
-      (declare (ignore bottom))
+      (medium-clear-area medium left top right bottom)
       ;; fixed bug when :align-x not :left (cim 10/14/96)
       (let* ((align-x (gadget-alignment pane))
              (x (ecase align-x
diff --git a/tk-silica/xm-frames.lisp b/tk-silica/xm-frames.lisp
index 5ea2618e9b18d1b8231bc95b66106ae91c1c6366..4c74b660cc70d6543b3e7224748df0843582aae8 100644
--- a/tk-silica/xm-frames.lisp
+++ b/tk-silica/xm-frames.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: xm-frames.lisp,v 1.77 1998/08/06 23:17:25 layer Exp $
+;; $Id: xm-frames.lisp,v 1.78 1998/10/08 18:36:24 layer Exp $
 
 (in-package :xm-silica)
 
@@ -144,7 +144,10 @@
 		    '(:font-list)))
 	 ;; menu-text-style used to be (pane-text-style sheet)
 	 ;; changed 28May97 -tjm
-	 (menu-text-style clim-internals::*default-menu-text-style*)
+	 ;; changed back 14Sep98 JPM 
+	 ;; (X resource database should provide default text styles - spr18064)
+	 (menu-text-style (pane-text-style sheet) 
+			  #+ignore clim-internals::*default-menu-text-style*)
 	 (frame (pane-frame sheet))
 	 (top-command-table (or (menu-bar-command-table sheet)
 				(frame-command-table frame)))
diff --git a/utils/last.lisp b/utils/last.lisp
index 947f8bcbb40b5f6bb8b6467aab16fba6ce440a5c..4ebc0c64e763f8fe06a68d493cf3b79acd05c614 100644
--- a/utils/last.lisp
+++ b/utils/last.lisp
@@ -15,14 +15,15 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Id: last.lisp,v 1.2 1998/08/06 23:17:34 layer Exp $
+;; $Id: last.lisp,v 1.3 1998/10/08 18:36:26 layer Exp $
 
 (in-package :system)
 
 #-(version>= 5 0 pre-final 16)
 (load-patches "patch" "sys:;update-clim;*.fasl")
 #+(version>= 5 0 pre-final 16)
-(load-patches :product #.*patch-product-code-clim*)
+(load-patches :product #.*patch-product-code-clim*
+	      :version #.excl::*cl-patch-version-char*)
 
 (provide
  #+mswindows :climnt
diff --git a/utils/packages.lisp b/utils/packages.lisp
index c316018743f4015b6ebc0e305e6e3b8e77237906..6fae46b2555651a2dd89d26b5e50864911d25a0c 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.87 1998/09/29 21:02:38 duane Exp $
+;; $Id: packages.lisp,v 1.88 1998/10/08 18:36:27 layer Exp $
 
 (in-package :common-lisp-user)
 
@@ -3315,7 +3315,7 @@
 (cl:defvar *clim-major-version* 2)
 (cl:defvar *clim-minor-version* 2)
 (cl:defvar *clim-generation-version* 2)
-(cl:defvar *clim-build-version* 2)
+(cl:defvar *clim-build-version* 3)
 
 (cl:defparameter *clim-version*
     (cl:format () "~d.~d.~d.~a"