diff --git a/ChangeLog.n b/ChangeLog.n
index 42bd2bac1a72add38415e4db78e943c0384af969..453891ae982c043080b58027cd6867ffe5722b91 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -1,3 +1,145 @@
+*******************************************************************************
+Tue Jul 23 14:29:37 PDT 1996 Colin Meldrum (colin@vapor)
+
+Makefile.defs
+	Changed WNNLIB to be libwnn.a instead of ./libwnn.a - was confusing 
+	the make rules for building a developer CLIM (slim)
+
+Makefile.hpprism, Makefile.sun4, Makefile.sun4-svr4
+	Commented out WNNLIB=/usr/fi/X11R5/lib/libwnn.a becuase all the
+	libwnn stuff is part of the main clim-2.0 tree in clim-2.0/wnn 
+	
+clim/accept-values.lisp
+	Fixed dumb :right y-position bug in invoke-accepting-values - see
+	patch3502 
+	Fix bug in space allocation resulting in dialogs being larger than
+	the screen - see patch3510
+	pass view-gadget-initargs to pixmap-from-menu-item in
+	invoke-accept-values-command-button-1 - fixes bug with background
+	not being set for certain classes of accept-values-command-button 
+	- see patch3505-02
+	Added support for graying out of accept-values-command-buttons in
+	conjunction with computed prompts in call to pixmap-from-menu-item
+	- see patch3505-03
+clim/drag-and-drop.lisp
+	rework of drag-and-drop for spr14044 and spr14290
+
+clim/frames.lisp
+	Added a frame-manager method for graft - see patch3507
+	added *graft-maximum-size-factor* - see patch3511
+
+clim/gadget-output.lisp
+	Added :label-options and :borders initargs to views for
+	radio-box-view and check-box-view - see patch3505
+	Added :borders initarg to views for slider-view and
+	toggle-button-view  - see patch3504
+	pass view-gadget-initargs to pixmap-from-menu-item in
+	accept-present-default method for radio-box-view and check-box-view 
+	- fixes bug with background  being set - see patch3505-02
+	Added support for graying out of toggle button labels radio-box and 
+	check-box-view in call to pixmap-from-menu-item - see patch3505-03
+
+clim/interactive-protocol.lisp
+	Added default stream-scan-pointer method which calls file-position
+
+clim/output-protocol.lisp
+	Added default stream-cursor-position method to make filling-output
+	work on string-streams
+
+clim/pixmap-streams.lisp
+	Added support for graying out in pixmap-from-menu-item to make
+	CLIM gray out inactive gadgets because Motif doesn't provide the
+	support for graying out of pixmap labels - see patch3505-03
+	Added :text-style, :background and :foreground initargs to
+	pixmap-from-menu-item - see changes for gadget-output.lisp and
+	accept-values.lisp - see patch3505-02
+
+clim/tanslators.lisp
+	added optional use-default-args arg to write-translator-function
+	misc support for drag-and-drop changes.
+
+demo/listener.lisp
+	added (:pointer-documentation t) clause to lisp-listener demo
+
+misc/compile-1.lisp
+	removed #+ics check compiling 'wnn system. Change made to allow
+	building of non-ics developer CLIM (slim)
+
+silica/gadgets.lisp
+	Added spacing slot to row-column-gadget-mixin - see patch3506
+	Changed default visible-items in compute-list-pane-selected-items
+	to +fill+ - see patch3508
+
+silica/text-style.lisp
+	Addeded text-style-xxx trampoline methods for text-style
+	specifications given as lists - see patch3503-02
+
+test/test-clim.lisp
+	Added a filling-output-on-string-stream-test
+
+test/test-suite.lisp
+	Extended drag and drop test to check out new :documention and
+	:pointer-documentation options 
+	Added a gadget-resoure-dialog test to test the new
+	pixmap-from-menu-item fixes
+	added (:pointer-documentation t) clause to clim-tests frame
+
+tk/graphics.lisp
+	fixed bug in draw-image-string to call xdrawimagestring
+
+tk/macros.lisp
+	fixed bug in lisp-string-to-string16 to do the right thing with
+	byte ordering - this fixes what would otherwise be a bug with
+	iaclim for the dec alpha.
+
+tk/resources.lisp
+	removed bogus convert-resource-in method on (type (eql 'string))
+	This was a a 4.3 ics merge bug - see patch3500
+
+tk/xm-widgets.lisp
+	fixes bug in convert-resource-out method for xm-string in non ICS
+	CLIM which was breaking notify-user (and some other) dialogs 
+	- see patch3501 
+	
+tk-silica/xm-dialogs.lisp
+	Added :end-of-page-action :allow to the stream pane in a Motif
+	accepting-values :own-window t dialog
+
+tk-silica/xm-frames.lisp
+	fixed frame-manager-construct-menu method for motif-frame-manager
+	to deal with menu item sensitivity for buttons labelled with
+	pixmaps. CLIM now grays out the pixmap - see pixmap-from-menu-item
+	above in clim/pixmap-streams.lisp - see patch3505-03
+	
+tk-silica/xm-gadgets.lisp
+	Added support for :spacing initarg in find-widget-initargs-for-sheet
+	:around method on motif-row-column-gadget-mixin - see patch3506
+	Cleaned up :list-size-policy code for motif-list-pane
+	find-widget-initargs-class-and-name-for-sheet method
+	added a gadget-visible-items for motif-list-pane method - see patch3508
+	added :text-style, :background and :foreground args in call to
+	pixmap-from-menu-item for motif-option-pane setting and update code 
+	- see patch3505-02
+
+tk-silica/xt-silica.lisp
+	made font->text-style more robust in the presence of incomplete
+	font descriptions as provided with certain X servers 
+	- see patch3509
+
+utils/excl-verification.lisp
+	Changed *clim-version* to be "CLIM 2.1" This was missed for the 4.3 
+	release - take note!
+
+wnn/jserver.lisp
+	Changed initialize-instance :after method on jserver to call
+	ff:string-to-char* instead of tk::lisp-string-to-string8 so that
+	the wnn system can be compiled independently of xm-tk. Also in this 
+	case it's probably safer to have the string malloc'd.
+
+wnn/load-wnn.lisp
+	Wrapped this all in an excl:ics-target-case so that developer
+	builds of a non ICS CLIM image (slim) work.
+
 *******************************************************************************
 4.3.devel.17
 
diff --git a/Makefile.defs b/Makefile.defs
index 7a354123327e119361336e12c5fe9832fde307d1..09da2a671e14f4a29bbc4cc0297452f18fbaa97f 100644
--- a/Makefile.defs
+++ b/Makefile.defs
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.defs,v 1.36 1996/03/13 09:55:08 colin Exp $
+# $fiHeader: Makefile.defs,v 1.37 1996/03/15 05:17:58 colin Exp $
 #
 #  Makefile.defs for CLIM 2.0
 #
@@ -103,7 +103,7 @@ SHARED-XM-OBJS= climxm.so
 STATIC-OL-OBJS= stub-olit.o olsupport.o
 SHARED-OL-OBJS= climol.so
 
-WNNLIB = ./libwnn.a
+WNNLIB = libwnn.a
 STATIC-WNN-OBJS=stub-wnn.o $(WNNLIB)
 
 # The default is for statically linked Motif
diff --git a/Makefile.hpprism b/Makefile.hpprism
index d788cfe0206e5e1d52aa6e16913ff9990e061be6..644eb35f43f1dca51f2e21307ea6e32f62233596 100644
--- a/Makefile.hpprism
+++ b/Makefile.hpprism
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.hpprism,v 1.8 1995/10/20 17:36:08 colin Exp $
+# $fiHeader: Makefile.hpprism,v 1.9 1996/03/13 09:55:12 colin Exp $
 #
 #  Makefile.hpprism for CLIM 2.0
 #
@@ -18,9 +18,6 @@ TKLIB=/usr/lib/Motif1.2/libXm.a
 XTLIB=/usr/lib/X11R5/libXt.a
 XLIB=/usr/lib/X11R5/libX11.a
 
-# not needed anymore - we make libwnn.a in clim-2.0
-#WNNLIB=/usr/fi/X11R5/lib/libwnn.a
-
 XINCLUDES= -I/usr/include/Motif1.2 -I/usr/include/X11R5
 
 include Makefile.generic
diff --git a/Makefile.sun4 b/Makefile.sun4
index 3201d73d160b0a88b084e48827721ac4be70e5a6..05252dfd754f9f00e150771eb1156364b9a571cc 100644
--- a/Makefile.sun4
+++ b/Makefile.sun4
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.sun4,v 1.13 1996/03/13 09:55:17 colin Exp $
+# $fiHeader: Makefile.sun4,v 1.14 1996/03/15 05:18:05 colin Exp $
 #
 #  Makefile.sun4 for CLIM 2.0
 #
@@ -17,7 +17,5 @@ XLIB=/net/louie/malle/colin/X11R5/Ximp-libs/libX11.a
 
 AR = ar cq
 
-# not needed anymore - we make libwnn.a in clim-2.0
-#WNNLIB=/usr/fi/X11R5/lib/libwnn.a
 
 include Makefile.generic
diff --git a/Makefile.sun4-svr4 b/Makefile.sun4-svr4
index 44b06a90d43248599e69782f0cebc0259eadfe96..f80fe5b5ff674eeb2308f3aef2fbd523e8226d2a 100644
--- a/Makefile.sun4-svr4
+++ b/Makefile.sun4-svr4
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.sun4-svr4,v 1.10 1996/03/01 05:41:34 colin Exp $
+# $fiHeader: Makefile.sun4-svr4,v 1.11 1996/03/13 09:55:19 colin Exp $
 #
 #  Makefile.sun4-svr4 for CLIM 2.0
 #
@@ -17,9 +17,6 @@ TKLIB=-lXm
 XTLIB=-lXt
 XLIB=-lX11
 
-# not needed anymore - we make libwnn.a in clim-2.0
-#WNNLIB=/net/ultra/export/home/colin/X11R6/contrib/programs/Xsi/Wnn/jlib/libwnn.a
-
 SET_LIBRARY_PATH= \
   LD_LIBRARY_PATH=/usr/dt/lib:/usr/openwin/lib:/usr/lib; export LD_LIBRARY_PATH
 
diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index 899a77600916c31bcff70b3ec667d16255d33985..8365e39714602e42a1417d8a1acbcc47e8fe3074 100644
--- a/clim/accept-values.lisp
+++ b/clim/accept-values.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: accept-values.lisp,v 1.77 1995/10/17 05:01:12 colin Exp $
+;; $fiHeader: accept-values.lisp,v 1.78 1996/03/01 05:41:48 colin Exp $
 
 (in-package :clim-internals)
 
@@ -11,7 +11,7 @@
 ;;; For historical reasons "AVV" means "accepting-values"...
 
 (defclass accept-values-stream
-	  (standard-encapsulating-stream)
+          (standard-encapsulating-stream)
     ((avv-record :initform nil)
      (avv-frame :initform nil)
      (align-prompts :initform nil :initarg :align-prompts)))
@@ -21,7 +21,7 @@
 (defvar *current-accept-values-tick* 0)
 
 (defclass accept-values-output-record
-	  (standard-sequence-output-record)
+          (standard-sequence-output-record)
     ((query-table :initarg :query-table)
      (tick :initform *current-accept-values-tick*)
      (resynchronize :initform nil))
@@ -42,22 +42,22 @@
 (defclass accept-values-query ()
      ((query-identifier :initarg :query-identifier)
       (presentation-type :initarg :presentation-type
-			 :reader accept-values-query-type)
+                         :reader accept-values-query-type)
       (value :initarg :value
-	     :accessor accept-values-query-value)
+             :accessor accept-values-query-value)
       (presentation :initarg :presentation
-		    :accessor accept-values-query-presentation)
+                    :accessor accept-values-query-presentation)
       (changed-p :initform nil
-		 :accessor accept-values-query-changed-p)
+                 :accessor accept-values-query-changed-p)
       (active-p :initform t
-		:accessor accept-values-query-active-p)
+                :accessor accept-values-query-active-p)
       (error-p :initform nil
-	       :accessor accept-values-query-error-p))
+               :accessor accept-values-query-error-p))
   (:default-initargs :presentation nil))
 
 (defresource accept-values-stream (stream &key align-prompts)
   :constructor (make-instance 'accept-values-stream :stream stream)
-  :matcher 't					;any will suffice
+  :matcher 't                                   ;any will suffice
   :initializer
     (progn
       (setf (slot-value accept-values-stream 'stream) stream)
@@ -70,10 +70,10 @@
       (return record))))
 
 (defmethod prompt-for-accept :around ((stream accept-values-stream) type (view view)
-				      &rest accept-args
-				      &key query-identifier (prompt t) (display-default nil)
-					   (active-p t)
-				      &allow-other-keys)
+                                      &rest accept-args
+                                      &key query-identifier (prompt t) (display-default nil)
+                                           (active-p t)
+                                      &allow-other-keys)
   (declare (dynamic-extent accept-args))
   ;;--- When ACTIVE-P is NIL, this should do some sort of "graying out"
   (declare (ignore active-p))
@@ -84,175 +84,175 @@
     (setq query-identifier (list ':query-identifier prompt type)))
   (when (or prompt display-default)
     (updating-output (stream :unique-id (list :prompt query-identifier)
-			     :id-test #'equal
-			     :cache-value prompt)
+                             :id-test #'equal
+                             :cache-value prompt)
       (with-keywords-removed (prompt-args accept-args '(:display-default :query-identifier))
-	;; Explicitly pass DISPLAY-DEFAULT so that if it is not supplied by the
-	;; user, we forcibly default it to NIL, which gives better-looking AVVs.
-	(apply #'call-next-method stream type view
-	       			  :display-default display-default
-				  :query-identifier query-identifier
-				  prompt-args))))
+        ;; Explicitly pass DISPLAY-DEFAULT so that if it is not supplied by the
+        ;; user, we forcibly default it to NIL, which gives better-looking AVVs.
+        (apply #'call-next-method stream type view
+                                  :display-default display-default
+                                  :query-identifier query-identifier
+                                  prompt-args))))
   query-identifier)
 
 (defmethod prompt-for-accept ((stream accept-values-stream) type view
-			      &rest accept-args
-			      &key query-identifier &allow-other-keys)
+                              &rest accept-args
+                              &key query-identifier &allow-other-keys)
   ;; This does nothing, the gadget ACCEPT methods should provide a label
   (unless (gadget-includes-prompt-p type stream view)
     (call-next-method))
   query-identifier)
 
 (defmethod stream-accept ((stream accept-values-stream) type
-			  &rest accept-args
-			  &key (prompt t) query-identifier (default nil default-supplied-p)
-			       (view (stream-default-view stream)) (active-p t)
-			  &allow-other-keys)
+                          &rest accept-args
+                          &key (prompt t) query-identifier (default nil default-supplied-p)
+                               (view (stream-default-view stream)) (active-p t)
+                          &allow-other-keys)
   (declare (dynamic-extent accept-args))
   ;;--- When ACTIVE-P is NIL, this should do some sort of "graying out"
   (let ((align-prompts (slot-value stream 'align-prompts)) query)
     (cond (align-prompts
-	   ;; The user has asked to line up the labels, so oblige him
-	   (updating-output (stream :unique-id (cons '#:accept (or query-identifier prompt))
-				    :id-test #'equal)
-	     (formatting-row (stream)
-	       (formatting-cell (stream :align-x align-prompts)
-		 (setq query-identifier
-		   (apply #'prompt-for-accept
-			  (encapsulating-stream stream) type view accept-args)))
-	       (letf-globally (((slot-value stream 'align-prompts) nil))
-		 (formatting-cell (stream :align-x :left)
-		   (setq query (find-or-add-query stream query-identifier type prompt
-						  default default-supplied-p view active-p)))))))
-	  (t
-	   (setq query-identifier
-		 (apply #'prompt-for-accept
-			(encapsulating-stream stream) type view accept-args))
-	   (setq query (find-or-add-query stream query-identifier type prompt
-					  default default-supplied-p view active-p))))
+           ;; The user has asked to line up the labels, so oblige him
+           (updating-output (stream :unique-id (cons '#:accept (or query-identifier prompt))
+                                    :id-test #'equal)
+             (formatting-row (stream)
+               (formatting-cell (stream :align-x align-prompts)
+                 (setq query-identifier
+                   (apply #'prompt-for-accept
+                          (encapsulating-stream stream) type view accept-args)))
+               (letf-globally (((slot-value stream 'align-prompts) nil))
+                 (formatting-cell (stream :align-x :left)
+                   (setq query (find-or-add-query stream query-identifier type prompt
+                                                  default default-supplied-p view active-p)))))))
+          (t
+           (setq query-identifier
+                 (apply #'prompt-for-accept
+                        (encapsulating-stream stream) type view accept-args))
+           (setq query (find-or-add-query stream query-identifier type prompt
+                                          default default-supplied-p view active-p))))
     (values (accept-values-query-value query)
-	    (accept-values-query-type query)
-	    ;; Set this to NIL so that it appears that nothing has
-	    ;; changed at the start of the next pass.
-	    (prog1 (accept-values-query-changed-p query)
-		   (setf (accept-values-query-changed-p query) nil)))))
+            (accept-values-query-type query)
+            ;; Set this to NIL so that it appears that nothing has
+            ;; changed at the start of the next pass.
+            (prog1 (accept-values-query-changed-p query)
+                   (setf (accept-values-query-changed-p query) nil)))))
 
 ;; Probably should be keyword arguments...
 
 
 (defmethod find-or-add-query ((stream accept-values-stream) query-identifier ptype prompt
-			      default default-supplied-p view active-p)
+                              default default-supplied-p view active-p)
   (let ((avv-record (slot-value stream 'avv-record)))
     (with-slots (query-table) avv-record
       (multiple-value-bind (query found-p)
-	  (gethash query-identifier query-table)
-	(unless query
-	  (setq query (make-instance 'accept-values-query
-			:presentation-type ptype
-			:value default
-			:query-identifier query-identifier)))
-	(setf (accept-values-query-active-p query) active-p)
-	;;--- Really wants to reuse existing presentation if found and
-	;;--- make sure that that presentation gets re-parented if necessary
-	;;--- (suppose inside FORMATTING TABLE...)
-	(setf (accept-values-query-presentation query)
-	      (updating-output
-		  (stream :unique-id query-identifier
-			  ;;-- If the old-style text field value is
-			  ;;-- unchanged then we need this hack
-			  :all-new (and (not (typep view 'actual-gadget-view))
-					 (accept-values-query-changed-p query))
-			  :id-test #'equal
-			  :cache-value (list (if (accept-values-query-changed-p query)
-						 (accept-values-query-value query)
-					       default)
-					     ptype
-					     active-p)
-			  :cache-test #'(lambda (x y)
-					  (unless (accept-values-query-changed-p query)
-					    (equal x y))))
-		;;--- Calling ACCEPT-1 directly bypasses default preprocessing,
-		;;--- is that OK?
-		(cond ((or default-supplied-p (accept-values-query-changed-p query))
-		       (accept-1 stream ptype
-				 :view view :prompt prompt
-				 ;; If this field changed, use the value it changed to,
-				 ;; making sure that the query object gets changed, too.
-				 ;; We need to do this because the body of the dialog
-				 ;; can change values without changing the query itself.
-				 :default (if (accept-values-query-changed-p query)
-					      (accept-values-query-value query)
-					      (setf (accept-values-query-error-p query) nil
-						  (accept-values-query-value query) default))
-				 :history ptype
-				 :present-p `(accept-values-choice ,query)
-				 :query-identifier query
-				 :active-p active-p))
-		      ((and found-p
-			    (presentation-typep (accept-values-query-value query) ptype))
-		       ;; The programmer supplied no default, but a previous edit
-		       ;; has put something in the query that we now must use as
-		       ;; the default.
-		       (accept-1 stream ptype
-				 :view view :prompt prompt
-				 :default (accept-values-query-value query)
-				 :history ptype
-				 :present-p `(accept-values-choice ,query)
-				 :query-identifier query
-				 :active-p active-p))
-		      (t
-		       ;; No default supplied, field has never been edited.
-		       (accept-1 stream ptype
-				 :view view :prompt prompt
-				 :history ptype :provide-default nil
-				 :present-p `(accept-values-choice ,query)
-				 :query-identifier query
-				 :active-p active-p)))))
-	;; really wants to move the cursor position to some reasonable
-	;; place in case we're just reusing an existing presentation
-	(unless found-p
-	  (setf (gethash query-identifier query-table) query))
-	query))))
+          (gethash query-identifier query-table)
+        (unless query
+          (setq query (make-instance 'accept-values-query
+                        :presentation-type ptype
+                        :value default
+                        :query-identifier query-identifier)))
+        (setf (accept-values-query-active-p query) active-p)
+        ;;--- Really wants to reuse existing presentation if found and
+        ;;--- make sure that that presentation gets re-parented if necessary
+        ;;--- (suppose inside FORMATTING TABLE...)
+        (setf (accept-values-query-presentation query)
+              (updating-output
+                  (stream :unique-id query-identifier
+                          ;;-- If the old-style text field value is
+                          ;;-- unchanged then we need this hack
+                          :all-new (and (not (typep view 'actual-gadget-view))
+                                         (accept-values-query-changed-p query))
+                          :id-test #'equal
+                          :cache-value (list (if (accept-values-query-changed-p query)
+                                                 (accept-values-query-value query)
+                                               default)
+                                             ptype
+                                             active-p)
+                          :cache-test #'(lambda (x y)
+                                          (unless (accept-values-query-changed-p query)
+                                            (equal x y))))
+                ;;--- Calling ACCEPT-1 directly bypasses default preprocessing,
+                ;;--- is that OK?
+                (cond ((or default-supplied-p (accept-values-query-changed-p query))
+                       (accept-1 stream ptype
+                                 :view view :prompt prompt
+                                 ;; If this field changed, use the value it changed to,
+                                 ;; making sure that the query object gets changed, too.
+                                 ;; We need to do this because the body of the dialog
+                                 ;; can change values without changing the query itself.
+                                 :default (if (accept-values-query-changed-p query)
+                                              (accept-values-query-value query)
+                                              (setf (accept-values-query-error-p query) nil
+                                                  (accept-values-query-value query) default))
+                                 :history ptype
+                                 :present-p `(accept-values-choice ,query)
+                                 :query-identifier query
+                                 :active-p active-p))
+                      ((and found-p
+                            (presentation-typep (accept-values-query-value query) ptype))
+                       ;; The programmer supplied no default, but a previous edit
+                       ;; has put something in the query that we now must use as
+                       ;; the default.
+                       (accept-1 stream ptype
+                                 :view view :prompt prompt
+                                 :default (accept-values-query-value query)
+                                 :history ptype
+                                 :present-p `(accept-values-choice ,query)
+                                 :query-identifier query
+                                 :active-p active-p))
+                      (t
+                       ;; No default supplied, field has never been edited.
+                       (accept-1 stream ptype
+                                 :view view :prompt prompt
+                                 :history ptype :provide-default nil
+                                 :present-p `(accept-values-choice ,query)
+                                 :query-identifier query
+                                 :active-p active-p)))))
+        ;; really wants to move the cursor position to some reasonable
+        ;; place in case we're just reusing an existing presentation
+        (unless found-p
+          (setf (gethash query-identifier query-table) query))
+        query))))
 
 ;;--- It seems a little bizarre having a prompt argument, but we can't
 ;;--- think of a better way.
 (defmethod stream-present ((stream accept-values-stream) object presentation-type
-			   &rest present-args
-			   &key view (prompt nil prompt-p) (query-identifier nil)
-			   &allow-other-keys)
+                           &rest present-args
+                           &key view (prompt nil prompt-p) (query-identifier nil)
+                           &allow-other-keys)
   (declare (dynamic-extent present-args))
   (declare (ignore prompt))
   (unless prompt-p
     ;; This is the normal, non-gadget case of doing PRESENT
     (return-from stream-present (call-next-method)))
   (flet ((do-present (stream)
-	   (updating-output (stream :unique-id query-identifier
-				    :id-test #'equal
-				    :cache-value object
-				    :cache-test #'equal)
-	     stream
-	     ;;--- We did this because (SEQUENCE INTEGER) reinvoked
-	     ;;--- PRESENT with the prompt for each of components of
-	     ;;--- the stream, which ended up back here creating badly
-	     ;;--- identified updating-output records.
-	     (apply #'stream-present (encapsulating-stream-stream stream)
-		    object presentation-type present-args))))
+           (updating-output (stream :unique-id query-identifier
+                                    :id-test #'equal
+                                    :cache-value object
+                                    :cache-test #'equal)
+             stream
+             ;;--- We did this because (SEQUENCE INTEGER) reinvoked
+             ;;--- PRESENT with the prompt for each of components of
+             ;;--- the stream, which ended up back here creating badly
+             ;;--- identified updating-output records.
+             (apply #'stream-present (encapsulating-stream-stream stream)
+                    object presentation-type present-args))))
     (declare (dynamic-extent #'do-present))
     (let ((align-prompts (slot-value stream 'align-prompts)))
       (cond (align-prompts
-	     ;; The user has asked to line up the labels, so oblige him
-	     (formatting-row (stream)
-	       (formatting-cell (stream :align-x align-prompts)
-		 (setq query-identifier
-		       (apply #'prompt-for-accept (encapsulating-stream stream)
-			      presentation-type view present-args)))
-	       (formatting-cell (stream :align-x :left)
-		 (do-present stream))))
-	    (t
-	     (setq query-identifier
-		   (apply #'prompt-for-accept (encapsulating-stream stream)
-			  presentation-type view present-args))
-	     (do-present stream)))))
+             ;; The user has asked to line up the labels, so oblige him
+             (formatting-row (stream)
+               (formatting-cell (stream :align-x align-prompts)
+                 (setq query-identifier
+                       (apply #'prompt-for-accept (encapsulating-stream stream)
+                              presentation-type view present-args)))
+               (formatting-cell (stream :align-x :left)
+                 (do-present stream))))
+            (t
+             (setq query-identifier
+                   (apply #'prompt-for-accept (encapsulating-stream stream)
+                          presentation-type view present-args))
+             (do-present stream)))))
   (values object))
 
 
@@ -281,40 +281,40 @@
      (align-prompts :initform nil :initarg :align-prompts))
     (:pane
      (let ((frame *application-frame*)
-	   panes)
+           panes)
        (with-slots (stream own-window exit-button-stream scroll-bars align-prompts)  frame
-	 (multiple-value-setq (panes own-window exit-button-stream)
-			      (frame-manager-construct-avv-panes
-			       frame (frame-manager frame)))
-	 (setq stream (make-instance 'accept-values-stream
-				     :align-prompts align-prompts
-				     :stream own-window))
-	 panes)))
+         (multiple-value-setq (panes own-window exit-button-stream)
+                              (frame-manager-construct-avv-panes
+                               frame (frame-manager frame)))
+         (setq stream (make-instance 'accept-values-stream
+                                     :align-prompts align-prompts
+                                     :stream own-window))
+         panes)))
   (:menu-bar nil)
   (:top-level (accept-values-top-level))
   (:command-table accept-values)
   (:command-definer nil))
 
 (defmethod frame-manager-construct-avv-panes ((frame accept-values-own-window)
-					      (framem standard-frame-manager))
+                                              (framem standard-frame-manager))
   (let (exit-button-stream own-window)
     (values
      (with-look-and-feel-realization (framem frame)
        (with-slots (scroll-bars) frame
-	 (vertically ()
-	   (outlining ()
-	     (progn
-	       (setq own-window
-		 (make-pane 'clim-stream-pane
-			    :initial-cursor-visibility :off
-			    :end-of-page-action :allow))
-	       (if scroll-bars
-		   (scrolling (:scroll-bars scroll-bars) own-window)
-		 own-window)))
-	   (outlining ()
-	     (setf exit-button-stream
-	       (make-pane 'clim-stream-pane
-			  :initial-cursor-visibility nil))))))
+         (vertically ()
+           (outlining ()
+             (progn
+               (setq own-window
+                 (make-pane 'clim-stream-pane
+                            :initial-cursor-visibility :off
+                            :end-of-page-action :allow))
+               (if scroll-bars
+                   (scrolling (:scroll-bars scroll-bars) own-window)
+                 own-window)))
+           (outlining ()
+             (setf exit-button-stream
+               (make-pane 'clim-stream-pane
+                          :initial-cursor-visibility nil))))))
      own-window
      exit-button-stream)))
 
@@ -326,7 +326,7 @@
   '((:abort) (:exit)))
 
 (defmethod frame-manager-exit-box-labels
-	   ((framem standard-frame-manager) frame view)
+           ((framem standard-frame-manager) frame view)
   (declare (ignore frame view))
   '((:exit   "Exit")
     (:abort  "Cancel")))
@@ -336,283 +336,287 @@
 
 
 (defun invoke-accepting-values (stream continuation
-				 &key frame-class command-table
-				      own-window background foreground text-style
-				      (exit-boxes
-					(frame-manager-default-exit-boxes
-					  (frame-manager stream)))
- 				      (resize-frame nil) (scroll-bars nil)
-				      (initially-select-query-identifier nil)
-				      (modify-initial-query nil) align-prompts
-				      (resynchronize-every-pass nil) (check-overlapping t)
-				      label x-position y-position
-				      width height (right-margin 10) (bottom-margin 10)
-				      view)
+                                 &key frame-class command-table
+                                      own-window background foreground text-style
+                                      (exit-boxes
+                                        (frame-manager-default-exit-boxes
+                                          (frame-manager stream)))
+                                      (resize-frame nil) (scroll-bars nil)
+                                      (initially-select-query-identifier nil)
+                                      (modify-initial-query nil) align-prompts
+                                      (resynchronize-every-pass nil) (check-overlapping t)
+                                      label x-position y-position
+                                      width height (right-margin 10) (bottom-margin 10)
+                                      view)
    (incf *accept-values-tick*)
    (setq align-prompts (ecase align-prompts
-			 ((t :right) :right)
-			 ((:left) :left)
-			 ((nil) nil)))
+                         ((t :right) :right)
+                         ((:left) :left)
+                         ((nil) nil)))
 
    (let ((frame-manager (frame-manager stream))
-	 (*current-accept-values-tick* *accept-values-tick*)
-	 (the-own-window nil))
+         (*current-accept-values-tick* *accept-values-tick*)
+         (the-own-window nil))
      ;; Create the AVV, run it, and return its values
      (if own-window
-	 (let ((frame (make-application-frame
-			(or frame-class
-			    (frame-manager-accepting-values-frame-class
-			     frame-manager))
-			;;--- What is the correct thing here?
-			:calling-frame (or (and (typep stream '(or basic-pane standard-encapsulating-stream))
-						(pane-frame stream))
-					   *application-frame*)
-			:input-buffer (and (typep stream '(or input-protocol-mixin standard-encapsulating-stream))
-					   (stream-input-buffer stream))
-			:frame-manager frame-manager
-			:pretty-name label
-			:continuation continuation
-			:exit-boxes exit-boxes
-			:own-window the-own-window
-			:own-window-properties (list x-position y-position
-						     width height
-						     right-margin bottom-margin)
-			:left x-position :right y-position
-			:initially-select-query-identifier
-			  (and initially-select-query-identifier
-			       (cons initially-select-query-identifier modify-initial-query))
-			:resynchronize-every-pass resynchronize-every-pass
-			:check-overlapping check-overlapping
-			:resize-frame resize-frame
-			:scroll-bars scroll-bars
-			:background background
-			:foreground foreground
-			:text-style text-style
-			:align-prompts align-prompts
-			:view view)))
-	   (when command-table
-	     (setf (frame-command-table frame) command-table))
-	   (unwind-protect
-	       (let ((*avv-calling-frame* *application-frame*))
-		 (run-frame-top-level frame))
-	     ;; Flush it so the GC can get rid of it
-	     (destroy-frame frame)))
-	 (using-resource (avv-stream accept-values-stream (or the-own-window stream)
-				     :align-prompts align-prompts)
-	   (let ((frame (make-application-frame (or frame-class 'accept-values)
-			  :calling-frame *application-frame*
-			  :stream avv-stream
-			  :continuation continuation
-			  :exit-boxes exit-boxes
-			  :initially-select-query-identifier
-			    (and initially-select-query-identifier
-				 (cons initially-select-query-identifier modify-initial-query))
-			  :resynchronize-every-pass resynchronize-every-pass
-			  :check-overlapping check-overlapping
-			  ;; This frame won't necessarily be adopted, so make
-			  ;; sure that we share the sheet with the parent frame
-			  ;; in the case of "inlined" dialogs
-			  :top-level-sheet (frame-top-level-sheet
-					    *application-frame*)
-			  :view view)))
-	     (when command-table
-	       (setf (frame-command-table frame) command-table))
-	     (unwind-protect
-		 (let ((*avv-calling-frame* *application-frame*))
-		   (run-frame-top-level frame))
-	       ;; Since this frame isn't really adopted, we don't really want
-	       ;; to disown it since that will end up disowning the calling
-	       ;; frame.  Flush it from the frame manager manually.  Barf.
-	       (let ((framem (frame-manager frame)))
-		 (setf (frame-manager-frames framem)
-		         (delete frame (frame-manager-frames framem))
-		       (slot-value frame 'frame-manager) nil))))))))
+         (let ((frame (make-application-frame
+                        (or frame-class
+                            (frame-manager-accepting-values-frame-class
+                             frame-manager))
+                        ;;--- What is the correct thing here?
+                        :calling-frame (or (and (typep stream '(or basic-pane standard-encapsulating-stream))
+                                                (pane-frame stream))
+                                           *application-frame*)
+                        :input-buffer (and (typep stream '(or input-protocol-mixin standard-encapsulating-stream))
+                                           (stream-input-buffer stream))
+                        :frame-manager frame-manager
+                        :pretty-name label
+                        :continuation continuation
+                        :exit-boxes exit-boxes
+                        :own-window the-own-window
+                        :own-window-properties (list x-position y-position
+                                                     width height
+                                                     right-margin bottom-margin)
+                        :left x-position :top y-position
+                        :initially-select-query-identifier
+                          (and initially-select-query-identifier
+                               (cons initially-select-query-identifier modify-initial-query))
+                        :resynchronize-every-pass resynchronize-every-pass
+                        :check-overlapping check-overlapping
+                        :resize-frame resize-frame
+                        :scroll-bars scroll-bars
+                        :background background
+                        :foreground foreground
+                        :text-style text-style
+                        :align-prompts align-prompts
+                        :view view)))
+           (when command-table
+             (setf (frame-command-table frame) command-table))
+           (unwind-protect
+               (let ((*avv-calling-frame* *application-frame*))
+                 (run-frame-top-level frame))
+             ;; Flush it so the GC can get rid of it
+             (destroy-frame frame)))
+         (using-resource (avv-stream accept-values-stream (or the-own-window stream)
+                                     :align-prompts align-prompts)
+           (let ((frame (make-application-frame (or frame-class 'accept-values)
+                          :calling-frame *application-frame*
+                          :stream avv-stream
+                          :continuation continuation
+                          :exit-boxes exit-boxes
+                          :initially-select-query-identifier
+                            (and initially-select-query-identifier
+                                 (cons initially-select-query-identifier modify-initial-query))
+                          :resynchronize-every-pass resynchronize-every-pass
+                          :check-overlapping check-overlapping
+                          ;; This frame won't necessarily be adopted, so make
+                          ;; sure that we share the sheet with the parent frame
+                          ;; in the case of "inlined" dialogs
+                          :top-level-sheet (frame-top-level-sheet
+                                            *application-frame*)
+                          :view view)))
+             (when command-table
+               (setf (frame-command-table frame) command-table))
+             (unwind-protect
+                 (let ((*avv-calling-frame* *application-frame*))
+                   (run-frame-top-level frame))
+               ;; Since this frame isn't really adopted, we don't really want
+               ;; to disown it since that will end up disowning the calling
+               ;; frame.  Flush it from the frame manager manually.  Barf.
+               (let ((framem (frame-manager frame)))
+                 (setf (frame-manager-frames framem)
+                         (delete frame (frame-manager-frames framem))
+                       (slot-value frame 'frame-manager) nil))))))))
 
 (defvar *editting-field-p* nil)
 
 (defmethod accept-values-top-level ((frame accept-values) &rest args)
   (declare (ignore args))
   (with-slots (stream continuation resynchronize-every-pass check-overlapping
-	       selected-item initially-select-query-identifier
-	       own-window own-window-properties exit-button-stream view) frame
+               selected-item initially-select-query-identifier
+               own-window own-window-properties exit-button-stream view) frame
     (let* ((original-view (stream-default-view stream))
-	   (return-values nil)
-	   (initial-query nil)
-	   exit-button-record
-	   avv avv-record
-	   (align-prompts (slot-value stream 'align-prompts))
-	   (properties own-window-properties)
-	   (own-window-x-position (pop properties))
-	   (own-window-y-position (pop properties))
-	   (own-window-width  (pop properties))
-	   (own-window-height (pop properties))
-	   (own-window-right-margin  (pop properties))
-	   (own-window-bottom-margin (pop properties))
-	   (view
-	    (or view
-		(frame-manager-dialog-view (frame-manager frame))))
-	   (*editting-field-p* nil))
+           (return-values nil)
+           (initial-query nil)
+           exit-button-record
+           avv avv-record
+           (align-prompts (slot-value stream 'align-prompts))
+           (properties own-window-properties)
+           (own-window-x-position (pop properties))
+           (own-window-y-position (pop properties))
+           (own-window-width  (pop properties))
+           (own-window-height (pop properties))
+           (own-window-right-margin  (pop properties))
+           (own-window-bottom-margin (pop properties))
+           (view
+            (or view
+                (frame-manager-dialog-view (frame-manager frame))))
+           (*editting-field-p* nil))
       (letf-globally (((stream-default-view stream) view)
-		      ((stream-read-gesture-cursor-state stream) nil))
-	(labels ((run-continuation (stream avv-record)
-		   (setf (slot-value stream 'avv-record) avv-record)
-		   (setf (slot-value stream 'avv-frame) frame)
-		   (with-output-recording-options (stream :draw nil :record t)
-		     (let ((*application-frame* *avv-calling-frame*))
-		       (if align-prompts
-			   ;; Use of FORMATTING-TABLE here implies that
-			   ;; no output should be done by the user code
-			   ;; outside of calls to FORMATTING-ROW and
-			   ;; FORMATTING-CELL.  Too bad.
-			   (formatting-table (stream)
-			     (setq return-values
-				   (multiple-value-list
-				       (funcall continuation
-						stream))))
-			 (progn
-			   (display-view-background stream view)
-			   (setq return-values
-				 (multiple-value-list
-				   (funcall continuation stream))))))
-		     (unless own-window
-		       (display-exit-boxes frame stream
-					   (stream-default-view stream)))))
-		 (run-avv ()
-		   (and initially-select-query-identifier
-			(setq initial-query
-			  (find-query avv-record
-				      (car initially-select-query-identifier)))
-			(move-focus-to-query stream
-					     initial-query
-					     (not (cdr initially-select-query-identifier)))
-			;; only do the redisplay if move-focus-to-query
-			;; returns t - ie for the non-gadget case
-			(redisplay avv stream :check-overlapping check-overlapping))
-		   (loop
-		     (let ((command
-			     (let ((command-stream (encapsulating-stream-stream stream)))
-			       ;; While we're reading commands, restore the view
-			       ;; to what it was before we started.
-			       (letf-globally (((stream-default-view command-stream)
-						original-view))
-				 (read-frame-command frame :stream command-stream)))))
-		       (if (and command (not (keyboard-event-p command)))
-			   (execute-frame-command frame command)
-			   (beep stream)))
-		     (with-deferred-gadget-updates
-		       (when (or resynchronize-every-pass
-				 (slot-value avv-record 'resynchronize))
-			 ;; When the user has asked to resynchronize every pass, that
-			 ;; means we should run the continuation an extra time to see
-			 ;; that all visible stuff is up to date.  That's all!
-			 (with-output-recording-options (stream :draw nil)
-			   (redisplay avv stream :check-overlapping
-				      check-overlapping)))
-		       (setf (slot-value avv-record 'resynchronize) nil)
-		       (when exit-button-record
-			 (redisplay exit-button-record exit-button-stream))
-		       (redisplay avv stream :check-overlapping check-overlapping)
-		       (when (ecase (frame-resizable frame)
-			       ((nil) nil)
-			       ((t :grow)
-				(and own-window
-				     (multiple-value-bind (width height)
-					 (bounding-rectangle-size
-					   (stream-output-history own-window))
-				       (multiple-value-bind (vwidth vheight)
-					   (bounding-rectangle-size
-					     (window-viewport own-window))
-					 (if (eq (frame-resizable frame) :grow)
-					     (or (> width vwidth) (> height vheight))
-					     (or (/= width vwidth) (/= height vheight))))))))
-			 (size-panes-appropriately)))))
-		 (size-panes-appropriately ()
-		   (changing-space-requirements (:layout t)
-		     ;; We really want to specify the min/max sizes of
-		     ;; the exit-button pane also
-		     (when exit-button-stream
-		       (size-frame-from-contents exit-button-stream
- 		         :size-setter
+                      ((stream-read-gesture-cursor-state stream) nil))
+        (labels ((run-continuation (stream avv-record)
+                   (setf (slot-value stream 'avv-record) avv-record)
+                   (setf (slot-value stream 'avv-frame) frame)
+                   (with-output-recording-options (stream :draw nil :record t)
+                     (let ((*application-frame* *avv-calling-frame*))
+                       (if align-prompts
+                           ;; Use of FORMATTING-TABLE here implies that
+                           ;; no output should be done by the user code
+                           ;; outside of calls to FORMATTING-ROW and
+                           ;; FORMATTING-CELL.  Too bad.
+                           (formatting-table (stream)
+                             (setq return-values
+                                   (multiple-value-list
+                                       (funcall continuation
+                                                stream))))
+                         (progn
+                           (display-view-background stream view)
+                           (setq return-values
+                                 (multiple-value-list
+                                   (funcall continuation stream))))))
+                     (unless own-window
+                       (display-exit-boxes frame stream
+                                           (stream-default-view stream)))))
+                 (run-avv ()
+                   (and initially-select-query-identifier
+                        (setq initial-query
+                          (find-query avv-record
+                                      (car initially-select-query-identifier)))
+                        (move-focus-to-query stream
+                                             initial-query
+                                             (not (cdr initially-select-query-identifier)))
+                        ;; only do the redisplay if move-focus-to-query
+                        ;; returns t - ie for the non-gadget case
+                        (redisplay avv stream :check-overlapping check-overlapping))
+                   (loop
+                     (let ((command
+                             (let ((command-stream (encapsulating-stream-stream stream)))
+                               ;; While we're reading commands, restore the view
+                               ;; to what it was before we started.
+                               (letf-globally (((stream-default-view command-stream)
+                                                original-view))
+                                 (read-frame-command frame :stream command-stream)))))
+                       (if (and command (not (keyboard-event-p command)))
+                           (execute-frame-command frame command)
+                           (beep stream)))
+                     (with-deferred-gadget-updates
+                       (when (or resynchronize-every-pass
+                                 (slot-value avv-record 'resynchronize))
+                         ;; When the user has asked to resynchronize every pass, that
+                         ;; means we should run the continuation an extra time to see
+                         ;; that all visible stuff is up to date.  That's all!
+                         (with-output-recording-options (stream :draw nil)
+                           (redisplay avv stream :check-overlapping
+                                      check-overlapping)))
+                       (setf (slot-value avv-record 'resynchronize) nil)
+                       (when exit-button-record
+                         (redisplay exit-button-record exit-button-stream))
+                       (redisplay avv stream :check-overlapping check-overlapping)
+                       (when (ecase (frame-resizable frame)
+                               ((nil) nil)
+                               ((t :grow)
+                                (and own-window
+                                     (multiple-value-bind (width height)
+                                         (bounding-rectangle-size
+                                           (stream-output-history own-window))
+                                       (multiple-value-bind (vwidth vheight)
+                                           (bounding-rectangle-size
+                                             (window-viewport own-window))
+                                         (if (eq (frame-resizable frame) :grow)
+                                             (or (> width vwidth) (> height vheight))
+                                             (or (/= width vwidth) (/= height vheight))))))))
+                         (size-panes-appropriately)))))
+                 (size-panes-appropriately ()
+                   (changing-space-requirements (:layout t)
+                     ;; We really want to specify the min/max sizes of
+                     ;; the exit-button pane also
+                     (when exit-button-stream
+                       (size-frame-from-contents exit-button-stream
+                         :size-setter
+                         #'(lambda (pane w h)
+                             (setf w (max w 1) h (max h 1))
+                             (change-space-requirements pane
+                               :width w :min-width w :max-width w
+                               :height h :min-height h :max-height h))
+                         :right-margin 0
+                         :bottom-margin 0))
+                     (when own-window
+                       (size-frame-from-contents own-window
+                         :size-setter
 			 #'(lambda (pane w h)
-			     (change-space-requirements pane
-			       :width w :min-width w :max-width w
-			       :height h :min-height h :max-height h))
-			 :right-margin 0
-			 :bottom-margin 0))
-		     (when own-window
-		       (size-frame-from-contents own-window
-			 :size-setter
-			 #'(lambda (pane w h)
-			     (change-space-requirements pane
-			       :width w :min-width w :max-width w
-			       :height h :min-height h :max-height h
-			       :resize-frame t))
+                             (change-space-requirements
+			      pane
+			      ;; only use the min-xxx if explicitly specified
+			      ;; in call to accepting-values (cim 7/12/96)
+			      :width w :min-width (and own-window-width w)
+			      :height h	:min-height (and own-window-height h)
+			      :resize-frame t))
 			 :width own-window-width
-			 :height own-window-height
-			 :right-margin own-window-right-margin
-			 :bottom-margin own-window-bottom-margin)))))
-	  (declare (dynamic-extent #'run-continuation #'run-avv
-				   #'size-panes-appropriately))
-	  (handler-bind ((frame-exit
-			   #'(lambda (condition)
-			       (let ((exit-frame (frame-exit-frame condition)))
-				 (when (eq frame exit-frame)
-				   (return-from accept-values-top-level
-				     (values-list return-values)))))))
-	    (setq avv
-		  (updating-output (stream)
-		    (setq avv-record
-			  (with-end-of-line-action (stream :allow)
-			    (with-end-of-page-action (stream :allow)
-			      (with-new-output-record
-				  (stream 'accept-values-output-record avv-record)
-				(run-continuation stream avv-record)))))))
-	    ;; In own window dialogs the buttons are displayed separately
-	    (when (and own-window exit-button-stream)
-	      (setq exit-button-record
-		    (updating-output (exit-button-stream)
-		      (with-end-of-line-action (exit-button-stream :allow)
-			(with-end-of-page-action (exit-button-stream :allow)
-			  (display-exit-boxes frame exit-button-stream
-					      (stream-default-view stream)))))))
-	    (unwind-protect
-		(cond (own-window
-		       (size-panes-appropriately)
-		       (frame-manager-position-dialog
-			(frame-manager frame)
-			frame
-			own-window-x-position own-window-y-position)
-		       (setf (window-visibility own-window) t)
-		       (with-input-focus (own-window)
-			 (when exit-button-record
-			   (replay exit-button-record exit-button-stream))
-			 (replay avv stream)
-			 (run-avv)))
-		      (t
-		       ;; Ensure that bottom of the AVV is visible.  I think that
-		       ;; this is OK even if the AVV is bigger than the viewport.
-		       (move-cursor-beyond-output-record
-			 (encapsulating-stream-stream stream) avv)
-		       (stream-ensure-cursor-visible stream)
-		       (replay avv stream)
-		       (run-avv)))
-	      (unless own-window
-		(deactivate-all-gadgets avv-record)
-		(move-cursor-beyond-output-record
-		  (encapsulating-stream-stream stream) avv)))))))))
+                         :height own-window-height
+                         :right-margin own-window-right-margin
+                         :bottom-margin own-window-bottom-margin)))))
+          (declare (dynamic-extent #'run-continuation #'run-avv
+                                   #'size-panes-appropriately))
+          (handler-bind ((frame-exit
+                           #'(lambda (condition)
+                               (let ((exit-frame (frame-exit-frame condition)))
+                                 (when (eq frame exit-frame)
+                                   (return-from accept-values-top-level
+                                     (values-list return-values)))))))
+            (setq avv
+                  (updating-output (stream)
+                    (setq avv-record
+                          (with-end-of-line-action (stream :allow)
+                            (with-end-of-page-action (stream :allow)
+                              (with-new-output-record
+                                  (stream 'accept-values-output-record avv-record)
+                                (run-continuation stream avv-record)))))))
+            ;; In own window dialogs the buttons are displayed separately
+            (when (and own-window exit-button-stream)
+              (setq exit-button-record
+                    (updating-output (exit-button-stream)
+                      (with-end-of-line-action (exit-button-stream :allow)
+                        (with-end-of-page-action (exit-button-stream :allow)
+                          (display-exit-boxes frame exit-button-stream
+                                              (stream-default-view stream)))))))
+            (unwind-protect
+                (cond (own-window
+                       (size-panes-appropriately)
+                       (frame-manager-position-dialog
+                        (frame-manager frame)
+                        frame
+                        own-window-x-position own-window-y-position)
+                       (setf (window-visibility own-window) t)
+                       (with-input-focus (own-window)
+                         (when exit-button-record
+                           (replay exit-button-record exit-button-stream))
+                         (replay avv stream)
+                         (run-avv)))
+                      (t
+                       ;; Ensure that bottom of the AVV is visible.  I think that
+                       ;; this is OK even if the AVV is bigger than the viewport.
+                       (move-cursor-beyond-output-record
+                         (encapsulating-stream-stream stream) avv)
+                       (stream-ensure-cursor-visible stream)
+                       (replay avv stream)
+                       (run-avv)))
+              (unless own-window
+                (deactivate-all-gadgets avv-record)
+                (move-cursor-beyond-output-record
+                 (encapsulating-stream-stream stream) avv)))))))))
 
 
 (defun find-query-gadget (query)
   (let ((record (accept-values-query-presentation query)))
     (when record
       (labels ((find-gadget-output-record (record)
-		 (typecase record
-		   (gadget-output-record
-		    (return-from find-query-gadget (output-record-gadget record)))
-		   (output-record
-		    (map-over-output-records #'find-gadget-output-record record)))))
-	(declare (dynamic-extent #'find-gadget-output-record))
-	(find-gadget-output-record record)))))
+                 (typecase record
+                   (gadget-output-record
+                    (return-from find-query-gadget (output-record-gadget record)))
+                   (output-record
+                    (map-over-output-records #'find-gadget-output-record record)))))
+        (declare (dynamic-extent #'find-gadget-output-record))
+        (find-gadget-output-record record)))))
 
 (defun move-focus-to-query (stream query &optional (editp t))
   (declare (ignore stream))
@@ -620,13 +624,13 @@
   ;;-- otherwise edit the field
   (let ((gadget (find-query-gadget query)))
     (cond (gadget
-	   (move-focus-to-gadget gadget))
-	  ;;-- This stuff will still loose on old style CLIM
-	  ;;-- member fields
-	  (editp
-	   (com-edit-avv-choice query))
-	  (t
-	   (com-modify-avv-choice query)))
+           (move-focus-to-gadget gadget))
+          ;;-- This stuff will still loose on old style CLIM
+          ;;-- member fields
+          (editp
+           (com-edit-avv-choice query))
+          (t
+           (com-modify-avv-choice query)))
     ;; return nil for the gadget case so that we avoid redisplay which
     ;; would otherwise mess up the gadget focus (cim 2/2/95)
     (not gadget)))
@@ -636,30 +640,30 @@
   nil)
 
 (defmethod invoke-with-aligned-prompts ((stream accept-values-stream) continuation
-					&key (align-prompts t))
+                                        &key (align-prompts t))
   (setq align-prompts (ecase align-prompts
-			((t :right) :right)
-			((:left) :left)
-			((nil) nil)))
+                        ((t :right) :right)
+                        ((:left) :left)
+                        ((nil) nil)))
   (let ((return-values nil))
     (flet ((run-continuation (stream)
-	     (if align-prompts
-		 (formatting-table (stream)
-		   (setq return-values
-		     (multiple-value-list
-			 (funcall continuation stream))))
-	       (setq return-values
-		 (multiple-value-list
-		     (funcall continuation stream))))))
+             (if align-prompts
+                 (formatting-table (stream)
+                   (setq return-values
+                     (multiple-value-list
+                         (funcall continuation stream))))
+               (setq return-values
+                 (multiple-value-list
+                     (funcall continuation stream))))))
       (let ((old-align-prompts (slot-value stream 'align-prompts)))
-	(unwind-protect
-	    (progn (setf (slot-value stream 'align-prompts) align-prompts)
-		   (if old-align-prompts
-		       (formatting-row (stream)
-			 (formatting-cell (stream)
-			   (run-continuation stream)))
-		     (run-continuation stream)))
-	  (setf (slot-value stream 'align-prompts) old-align-prompts))))
+        (unwind-protect
+            (progn (setf (slot-value stream 'align-prompts) align-prompts)
+                   (if old-align-prompts
+                       (formatting-row (stream)
+                         (formatting-cell (stream)
+                           (run-continuation stream)))
+                     (run-continuation stream)))
+          (setf (slot-value stream 'align-prompts) old-align-prompts))))
     (values-list return-values)))
 
 (defmethod invoke-with-aligned-prompts ((stream t) continuation &key align-prompts)
@@ -667,12 +671,12 @@
   (funcall continuation stream))
 
 (defmethod frame-manager-display-input-editor-error
-	   ((framem standard-frame-manager) (frame accept-values) stream error)
+           ((framem standard-frame-manager) (frame accept-values) stream error)
   ;;--- Resignal the error so the user can handle it
   ;;--- (in lieu of HANDLER-BIND-DEFAULT)
   (notify-user frame (princ-to-string error)
-	       :title "Input error"
-	       :style :error :exit-boxes '(:exit))
+               :title "Input error"
+               :style :error :exit-boxes '(:exit))
   (remove-activation-gesture stream)
   ;; Now wait until the user forces a rescan by typing
   ;; an input editing command
@@ -685,10 +689,10 @@
   ;;-- Yuck but think of a better way
   (let ((old-help *accept-help*))
     (accepting-values (stream :exit-boxes '(:exit)
-			      :label "Input editor help"
-			      :own-window t)
+                              :label "Input editor help"
+                              :own-window t)
       (let ((*accept-help* old-help))
-	(funcall continuation stream)))))
+        (funcall continuation stream)))))
 
 
 (defmethod accept-values-top-level :around ((frame accept-values-own-window) &rest args)
@@ -697,60 +701,60 @@
       (call-next-method)
     (with-slots (help-window) frame
       (when help-window
-	(deallocate-resource 'menu help-window)
-	(setq help-window nil)))))
+        (deallocate-resource 'menu help-window)
+        (setq help-window nil)))))
 
 (defmethod read-frame-command ((frame accept-values) &key (stream *standard-input*))
   (read-command (frame-command-table frame)
-		:stream stream
-		:command-parser 'menu-command-parser
-		:use-keystrokes t))
+                :stream stream
+                :command-parser 'menu-command-parser
+                :use-keystrokes t))
 
 (defmethod accept-values-resynchronize ((stream accept-values-stream))
   (setf (slot-value (slot-value stream 'avv-record) 'resynchronize) t))
 
 (defmethod accept-values-resize-window ((stream accept-values-stream))
   (with-slots (own-window own-window-properties)
-	      (slot-value stream 'avv-frame)
+              (slot-value stream 'avv-frame)
     (when own-window
     (let* ((own-window-x-position (pop own-window-properties))
-	   (own-window-y-position (pop own-window-properties))
-	   (own-window-width  (pop own-window-properties))
-	   (own-window-height (pop own-window-properties))
-	   (own-window-right-margin  (pop own-window-properties))
-	   (own-window-bottom-margin (pop own-window-properties)))
+           (own-window-y-position (pop own-window-properties))
+           (own-window-width  (pop own-window-properties))
+           (own-window-height (pop own-window-properties))
+           (own-window-right-margin  (pop own-window-properties))
+           (own-window-bottom-margin (pop own-window-properties)))
       (declare (ignore own-window-x-position own-window-y-position
-		       own-window-width own-window-height))
+                       own-window-width own-window-height))
       (multiple-value-bind (new-width new-height)
-	  (bounding-rectangle-size (slot-value stream 'avv-record))
-	(multiple-value-bind (width height)
-	    (window-inside-size own-window)
-	  (when (or (> new-width width)
-		    (> new-height height))
-	    (size-frame-from-contents own-window
-				      :right-margin own-window-right-margin
-				      :bottom-margin own-window-bottom-margin))))))))
+          (bounding-rectangle-size (slot-value stream 'avv-record))
+        (multiple-value-bind (width height)
+            (window-inside-size own-window)
+          (when (or (> new-width width)
+                    (> new-height height))
+            (size-frame-from-contents own-window
+                                      :right-margin own-window-right-margin
+                                      :bottom-margin own-window-bottom-margin))))))))
 
 
 (define-presentation-type accept-values-exit-box ())
 
 (defmacro with-exit-box-decoded ((value label text-style documentation show-as-default)
-				 exit-box labels &body body)
+                                 exit-box labels &body body)
   `(let* ((,value (if (consp ,exit-box) (first ,exit-box) ,exit-box))
-	  (,label (or (and (consp ,exit-box)
-			   (second ,exit-box))
-		      (second (assoc ,value ,labels))))
-	  (,text-style (or (and (consp ,exit-box)
-				(getf (cddr ,exit-box) :text-style))
-			   (getf (cddr (assoc ,value ,labels)) :text-style)))
-	  (,documentation (or (and (consp ,exit-box)
-				   (getf (cddr ,exit-box) :documentation))
-			      (getf (cddr (assoc ,value ,labels)) :documentation)))
-	  (,show-as-default
-	   (if (and (consp ,exit-box)
-		    (member :show-as-default (cddr ,exit-box)))
-	       (getf (cddr ,exit-box) :show-as-default)
-	     (getf (cddr (assoc ,value ,labels)) :show-as-default))))
+          (,label (or (and (consp ,exit-box)
+                           (second ,exit-box))
+                      (second (assoc ,value ,labels))))
+          (,text-style (or (and (consp ,exit-box)
+                                (getf (cddr ,exit-box) :text-style))
+                           (getf (cddr (assoc ,value ,labels)) :text-style)))
+          (,documentation (or (and (consp ,exit-box)
+                                   (getf (cddr ,exit-box) :documentation))
+                              (getf (cddr (assoc ,value ,labels)) :documentation)))
+          (,show-as-default
+           (if (and (consp ,exit-box)
+                    (member :show-as-default (cddr ,exit-box)))
+               (getf (cddr ,exit-box) :show-as-default)
+             (getf (cddr (assoc ,value ,labels)) :show-as-default))))
      ,@body))
 
 ;;; Applications can create their own AVV class and specialize this method in
@@ -764,26 +768,26 @@
   (let ((labels (frame-manager-exit-box-labels (frame-manager frame) frame view)))
     (updating-output (stream :unique-id stream :cache-value 'exit-boxes)
       (with-slots (exit-boxes) frame
-	(dolist (exit-box exit-boxes)
-	  (with-exit-box-decoded (value label text-style documentation show-as-default)
-	    exit-box labels
-	    (declare (ignore documentation show-as-default))
-	    (when label
-	      (with-text-style (stream text-style)
-		(with-output-as-presentation (stream value 'accept-values-exit-box)
-		  #-CCL-2
-		  (write-string label stream)
-		  #+CCL-2
-		  (if (eq value ':abort)
-		      ;; Kludge to print the cloverleaf char in MCL.
-		      ;; Needs an accompanying kludge in STREAM-WRITE-CHAR so that
-		      ;; #\CommandMark doesn't get lozenged.
-		      (progn
-			(with-text-style (stream '(:mac-menu :roman :normal))
-			  (write-char #\CommandMark stream))
-			(write-string "-. aborts" stream))
-		      (write-string label stream)))
-		(write-string " " stream)))))))))
+        (dolist (exit-box exit-boxes)
+          (with-exit-box-decoded (value label text-style documentation show-as-default)
+            exit-box labels
+            (declare (ignore documentation show-as-default))
+            (when label
+              (with-text-style (stream text-style)
+                (with-output-as-presentation (stream value 'accept-values-exit-box)
+                  #-CCL-2
+                  (write-string label stream)
+                  #+CCL-2
+                  (if (eq value ':abort)
+                      ;; Kludge to print the cloverleaf char in MCL.
+                      ;; Needs an accompanying kludge in STREAM-WRITE-CHAR so that
+                      ;; #\CommandMark doesn't get lozenged.
+                      (progn
+                        (with-text-style (stream '(:mac-menu :roman :normal))
+                          (write-char #\CommandMark stream))
+                        (write-string "-. aborts" stream))
+                      (write-string label stream)))
+                (write-string " " stream)))))))))
 
 ;;--- Get this right
 (defmethod frame-pointer-documentation-output ((frame accept-values-own-window))
@@ -800,8 +804,8 @@
 (defmethod deactivate-all-gadgets :after ((record gadget-output-record))
   (map-over-sheets
     #'(lambda (sheet)
-	(when (typep sheet 'gadget)
-	  (deactivate-gadget sheet)))
+        (when (typep sheet 'gadget)
+          (deactivate-gadget sheet)))
     (output-record-gadget record)))
 
 
@@ -816,8 +820,8 @@
 (defun-inline accept-values-query-valid-p (query query-record)
   (and (or (null query) (accept-values-query-active-p query))
        (let ((avv-record (find-accept-values-record query-record)))
-	 (and avv-record
-	      (= (slot-value avv-record 'tick) *current-accept-values-tick*)))))
+         (and avv-record
+              (= (slot-value avv-record 'tick) *current-accept-values-tick*)))))
 
 (define-accept-values-command com-edit-avv-choice
     ((choice 'accept-values-choice))
@@ -830,7 +834,7 @@
      :documentation "Edit this field"
      :pointer-documentation "Edit this field"
      :tester ((object presentation)
-	      (accept-values-query-valid-p object presentation))
+              (accept-values-query-valid-p object presentation))
      :gesture :edit-field)
     (object)
   (list object))
@@ -846,7 +850,7 @@
      :documentation "Modify this field"
      :pointer-documentation "Modify this field"
      :tester ((object presentation)
-	      (accept-values-query-valid-p object presentation))
+              (accept-values-query-valid-p object presentation))
      :gesture :modify-field)
     (object)
   (list object))
@@ -854,48 +858,48 @@
 (defmethod accept-values-query-edit-value ((query accept-values-query) stream &key modify)
   (with-slots (presentation-type value changed-p prompt presentation) query
     (let ((stream (encapsulating-stream-stream stream))
-	  (*editting-field-p* t))
+          (*editting-field-p* t))
       (with-stream-cursor-position-saved (stream)
-	(multiple-value-bind (xoff yoff)
-	    (convert-from-relative-to-absolute-coordinates
-	     stream (output-record-parent presentation))
-	  (multiple-value-bind (x y) (output-record-position presentation)
-	    (stream-set-cursor-position stream (+ x xoff) (+ y yoff))))
-	(unwind-protect
-	    (progn
-	      (erase-output-record presentation stream)
-	      (let* ((new-value nil)
-		     (aborted nil)
-		     (record
-		      (with-new-output-record (stream)
-			;; The text cursor should be visible while this ACCEPT is
-			;; waiting for input to be typed into this field
-			(letf-globally (((stream-read-gesture-cursor-state stream) t))
-			  (multiple-value-setq (new-value aborted)
-			    (catch-abort-gestures ("Abort editing the current field")
-			      (values
-			       (accept presentation-type
-				       :stream stream :prompt nil :default value
-				       :insert-default modify))))))))
-		;; This so that the input editor's typing gets erased properly.
-		(erase-output-record record stream)
-		;;--- Kludge until Bill can explain the whole
-		;;"leave the delimiter" vs "process the delimiter" scheme to me
-		(when (read-gesture :stream stream :peek-p t :timeout 0)
-		  (process-delimiter stream))
-		(unless aborted
-		  (setf value new-value))))
-	  (setf changed-p t))))))
+        (multiple-value-bind (xoff yoff)
+            (convert-from-relative-to-absolute-coordinates
+             stream (output-record-parent presentation))
+          (multiple-value-bind (x y) (output-record-position presentation)
+            (stream-set-cursor-position stream (+ x xoff) (+ y yoff))))
+        (unwind-protect
+            (progn
+              (erase-output-record presentation stream)
+              (let* ((new-value nil)
+                     (aborted nil)
+                     (record
+                      (with-new-output-record (stream)
+                        ;; The text cursor should be visible while this ACCEPT is
+                        ;; waiting for input to be typed into this field
+                        (letf-globally (((stream-read-gesture-cursor-state stream) t))
+                          (multiple-value-setq (new-value aborted)
+                            (catch-abort-gestures ("Abort editing the current field")
+                              (values
+                               (accept presentation-type
+                                       :stream stream :prompt nil :default value
+                                       :insert-default modify))))))))
+                ;; This so that the input editor's typing gets erased properly.
+                (erase-output-record record stream)
+                ;;--- Kludge until Bill can explain the whole
+                ;;"leave the delimiter" vs "process the delimiter" scheme to me
+                (when (read-gesture :stream stream :peek-p t :timeout 0)
+                  (process-delimiter stream))
+                (unless aborted
+                  (setf value new-value))))
+          (setf changed-p t))))))
 
 (defun map-over-accept-values-queries (avv-record continuation)
   (declare (dynamic-extent continuation))
   (labels ((map-queries (record)
-	     (let ((unique-id (and (updating-output-record-p record)
-				   (slot-value record 'unique-id))))
-	       (when (and (listp unique-id)
-			  (eq (first unique-id) :query-identifier))
-		 (funcall continuation record unique-id)))
-	     (map-over-output-records #'map-queries record)))
+             (let ((unique-id (and (updating-output-record-p record)
+                                   (slot-value record 'unique-id))))
+               (when (and (listp unique-id)
+                          (eq (first unique-id) :query-identifier))
+                 (funcall continuation record unique-id)))
+             (map-over-output-records #'map-queries record)))
     (declare (dynamic-extent #'map-queries))
     (map-queries avv-record)))
 
@@ -904,42 +908,42 @@
   (with-slots (stream selected-item) *application-frame*
     (let ((avv-record (slot-value stream 'avv-record)))
       (cond ((null selected-item)
-	     (map-over-accept-values-queries avv-record
-					     #'(lambda (record unique-id)
-		   (declare (ignore record))
-		   (return-from com-next-avv-choice
-		     (setq selected-item (find-query avv-record unique-id))))))
-	    (t
-	     (let* ((item (find-query avv-record (slot-value selected-item 'query-identifier)))
-		    (item-record (slot-value item 'presentation))
-		    (found-item nil))
-	       (map-over-accept-values-queries avv-record
-		 #'(lambda (record unique-id)
-		     (if found-item
-			 (return-from com-next-avv-choice
-			   (setq selected-item (find-query avv-record unique-id)))
-		       (when (eq record item-record)
-			 (setq found-item t)))))))))))
+             (map-over-accept-values-queries avv-record
+                                             #'(lambda (record unique-id)
+                   (declare (ignore record))
+                   (return-from com-next-avv-choice
+                     (setq selected-item (find-query avv-record unique-id))))))
+            (t
+             (let* ((item (find-query avv-record (slot-value selected-item 'query-identifier)))
+                    (item-record (slot-value item 'presentation))
+                    (found-item nil))
+               (map-over-accept-values-queries avv-record
+                 #'(lambda (record unique-id)
+                     (if found-item
+                         (return-from com-next-avv-choice
+                           (setq selected-item (find-query avv-record unique-id)))
+                       (when (eq record item-record)
+                         (setq found-item t)))))))))))
 
 #+Genera
 (define-accept-values-command (com-previous-avv-choice :keystroke (:p :control)) ()
   (with-slots (stream selected-item) *application-frame*
     (let ((avv-record (slot-value stream 'avv-record)))
       (cond ((null selected-item)
-	     ;;--- Do this
-	     )
-	    (t
-	     ;;--- Do this
-	     )))))
+             ;;--- Do this
+             )
+            (t
+             ;;--- Do this
+             )))))
 
 #+Genera
 (add-keystroke-to-command-table 'accept-values '(:e :control) :function
   #'(lambda (gesture numeric-argument)
       (declare (ignore gesture numeric-argument))
       (with-slots (selected-item) *application-frame*
-	(if (null selected-item)
-	    (beep)
-	    `(com-edit-avv-choice ,selected-item))))
+        (if (null selected-item)
+            (beep)
+            `(com-edit-avv-choice ,selected-item))))
   :errorp nil)
 
 (define-accept-values-command com-delete-avv-choice
@@ -951,7 +955,7 @@
      :documentation "Remove this field"
      :pointer-documentation "Remove this field"
      :tester ((object presentation)
-	      (accept-values-query-valid-p object presentation))
+              (accept-values-query-valid-p object presentation))
      :gesture :delete-field)
     (object)
   (list object))
@@ -960,7 +964,7 @@
   (with-slots (presentation-type value changed-p) query
     (when (presentation-typep nil presentation-type)
       (setf value nil
-	    changed-p t))))
+            changed-p t))))
 
 (define-gesture-name :exit-dialog  :keyboard (:end))
 #+allegro
@@ -971,23 +975,23 @@
   (let ((frame *application-frame*))
     (with-slots (stream) frame
       (when (verify-queries frame stream (slot-value stream 'avv-record))
-	(frame-exit frame)))))
+        (frame-exit frame)))))
 
 
 (defun verify-queries (frame stream avv-record)
   (let ((queries nil))
     (maphash
      #'(lambda (query-identifier query)
-	 (declare (ignore query-identifier))
-	 (when (and (accept-values-query-active-p query)
-		    (output-record-stream (accept-values-query-presentation query))
-		    (accept-values-query-error-p query))
-	   (push query queries)))
+         (declare (ignore query-identifier))
+         (when (and (accept-values-query-active-p query)
+                    (output-record-stream (accept-values-query-presentation query))
+                    (accept-values-query-error-p query))
+           (push query queries)))
      (slot-value avv-record 'query-table))
     (if queries
-	(progn
-	  (verify-queries-1 frame stream queries)
-	  nil)
+        (progn
+          (verify-queries-1 frame stream queries)
+          nil)
       t)))
 
 (defun verify-queries-1 (frame stream queries)
@@ -995,12 +999,12 @@
    frame
    stream
    (mapcar #'(lambda (query)
-	       (list
-		query
-		(slot-value query 'query-identifier)
-		(let ((condition (accept-values-query-error-p query)))
-		  (and (not (eq condition t)) condition))))
-	   queries))
+               (list
+                query
+                (slot-value query 'query-identifier)
+                (let ((condition (accept-values-query-error-p query)))
+                  (and (not (eq condition t)) condition))))
+           queries))
   (move-focus-to-query stream (car queries)))
 
 
@@ -1008,22 +1012,22 @@
 (defmethod display-invalid-queries ((frame standard-application-frame) stream query-info)
   (declare (ignore stream))
   (notify-user frame
-	       (format nil "The following fields are not valid:~:{~%~4T~A~@[: ~A~]~}"
-		       (mapcar #'(lambda (query-stuff)
-				   (destructuring-bind (query id condition) query-stuff
-				     (declare (ignore query))
-				     (list
-				      (if (and (consp id)
-					       (eq (car id) :query-identifier)
-					       (consp (cdr id))
-					       (stringp (second id)))
-					  (second id)
-					id)
-				      (and (not (eq condition t)) condition))))
-			       query-info))
-	       :title "Invalid Fields"
-	       :style :error
-	       :exit-boxes '(:exit)))
+               (format nil "The following fields are not valid:~:{~%~4T~A~@[: ~A~]~}"
+                       (mapcar #'(lambda (query-stuff)
+                                   (destructuring-bind (query id condition) query-stuff
+                                     (declare (ignore query))
+                                     (list
+                                      (if (and (consp id)
+                                               (eq (car id) :query-identifier)
+                                               (consp (cdr id))
+                                               (stringp (second id)))
+                                          (second id)
+                                        id)
+                                      (and (not (eq condition t)) condition))))
+                               query-info))
+               :title "Invalid Fields"
+               :style :error
+               :exit-boxes '(:exit)))
 
 (defmethod display-invalid-queries ((frame accept-values-own-window) stream queries)
   (display-invalid-queries (frame-calling-frame frame) stream queries))
@@ -1040,9 +1044,9 @@
   (let ((gadget (find-query-gadget query)))
     (when (and gadget (typep gadget '(or text-field text-editor)))
       (if errorp
-	  (setf (gadget-original-background gadget) (gadget-background gadget)
-		(gadget-background gadget) +red+)
-	(setf (gadget-background gadget) (gadget-original-background gadget))))))
+          (setf (gadget-original-background gadget) (gadget-background gadget)
+                (gadget-background gadget) +red+)
+        (setf (gadget-background gadget) (gadget-original-background gadget))))))
 
 ;; Focus-in callback/ value changed - establish normal
 ;; Focus-out callback - establish error condition
@@ -1056,11 +1060,11 @@
 
 (define-presentation-translator abort-or-exit-avv
     (accept-values-exit-box (command :command-table accept-values) accept-values
-     :tester-definitive t		;just like a to-command translator
+     :tester-definitive t               ;just like a to-command translator
      :documentation ((object stream)
-		     (case object
-		       (:exit (write-string "Exit" stream))
-		       (:abort (write-string "Abort" stream))))
+                     (case object
+                       (:exit (write-string "Exit" stream))
+                       (:abort (write-string "Abort" stream))))
      :gesture :select)
     (object)
   (case object
@@ -1078,62 +1082,62 @@
 (define-presentation-type accept-values-command-button ())
 
 (defmacro accept-values-command-button ((&optional stream &rest options &key (view nil viewp) &allow-other-keys) prompt
-														 &body body &environment env)
+                                                                                                                 &body body &environment env)
   #+Genera (declare (zwei:indentation 1 3 2 1))
   #-(or Genera Minima) (declare (ignore env))
   (declare (arglist ((&optional stream
-				&key documentation query-identifier
-				(cache-value t) (cache-test #'eql)
-				view resynchronize)
-		     prompt &body body)))
+                                &key documentation query-identifier
+                                (cache-value t) (cache-test #'eql)
+                                view resynchronize)
+                     prompt &body body)))
   (default-input-stream stream accept-values-command-button)
   (with-keywords-removed (options options '(:view))
     (let ((constant-prompt-p
-	   (and (constantp prompt #+(or Genera Minima) env)
-		(stringp (eval prompt #+(or Genera Minima-Developer) env)))))
+           (and (constantp prompt #+(or Genera Minima) env)
+                (stringp (eval prompt #+(or Genera Minima-Developer) env)))))
       `(flet ((avv-command-button-body () ,@body)
-	      ,@(unless constant-prompt-p
-		  `((avv-command-button-prompt (,stream) ,prompt))))
-	 ,@(unless constant-prompt-p
-	     `((declare (dynamic-extent #'avv-command-button-prompt))))
-	 (invoke-accept-values-command-button
-	  ,stream
-	  #'avv-command-button-body ,(if viewp view `(stream-default-view ,stream))
-	  ,(if constant-prompt-p
-	       (eval prompt #+(or Genera Minima-Developer) env)
-	     '#'avv-command-button-prompt)
-	  ,@options)))))
+              ,@(unless constant-prompt-p
+                  `((avv-command-button-prompt (,stream) ,prompt))))
+         ,@(unless constant-prompt-p
+             `((declare (dynamic-extent #'avv-command-button-prompt))))
+         (invoke-accept-values-command-button
+          ,stream
+          #'avv-command-button-body ,(if viewp view `(stream-default-view ,stream))
+          ,(if constant-prompt-p
+               (eval prompt #+(or Genera Minima-Developer) env)
+             '#'avv-command-button-prompt)
+          ,@options)))))
 
 (defmethod invoke-accept-values-command-button-1
-	   (stream continuation (view t) prompt
-	    &key (documentation (if (stringp prompt)
-				    prompt
-				    (with-output-to-string (stream)
-				      (funcall prompt stream))))
-		 (query-identifier (list ':button documentation))
-		 (cache-value t) (cache-test #'eql)
-		 resynchronize
-		 active-p)
+           (stream continuation (view t) prompt
+            &key (documentation (if (stringp prompt)
+                                    prompt
+                                    (with-output-to-string (stream)
+                                      (funcall prompt stream))))
+                 (query-identifier (list ':button documentation))
+                 (cache-value t) (cache-test #'eql)
+                 resynchronize
+                 active-p)
   (declare (dynamic-extent prompt)
-	   (ignore active-p))
+           (ignore active-p))
   (updating-output (stream :unique-id query-identifier :id-test #'equal
-			   :cache-value cache-value :cache-test cache-test)
+                           :cache-value cache-value :cache-test cache-test)
     (flet ((doit (stream)
-	     (with-output-as-presentation (stream
-					   (make-instance 'accept-values-command-button
-							  :continuation continuation
-							  :documentation documentation
-							  :resynchronize resynchronize)
-					   'accept-values-command-button)
-	       (if (stringp prompt)
-		   (write-string prompt stream)
-		 (funcall prompt stream)))))
+             (with-output-as-presentation (stream
+                                           (make-instance 'accept-values-command-button
+                                                          :continuation continuation
+                                                          :documentation documentation
+                                                          :resynchronize resynchronize)
+                                           'accept-values-command-button)
+               (if (stringp prompt)
+                   (write-string prompt stream)
+                 (funcall prompt stream)))))
       (let ((align-prompts (slot-value stream 'align-prompts)) query)
-	(if align-prompts
-	    (formatting-row (stream)
-	      (formatting-cell (stream) stream)
-	      (formatting-cell (stream) (doit stream)))
-	  (doit stream))))))
+        (if align-prompts
+            (formatting-row (stream)
+              (formatting-cell (stream) stream)
+              (formatting-cell (stream) (doit stream)))
+          (doit stream))))))
 
 (define-accept-values-command com-avv-command-button
     ((button 'accept-values-command-button)
@@ -1148,7 +1152,7 @@
      :documentation document-command-button
      :pointer-documentation document-command-button
      :tester ((presentation)
-	      (accept-values-query-valid-p nil presentation))
+              (accept-values-query-valid-p nil presentation))
      :gesture :select)
     (object presentation)
   (list object presentation))
@@ -1158,11 +1162,11 @@
   (declare (ignore presentation context-type frame event window x y))
   (let ((documentation (slot-value button 'documentation)))
     (cond ((stringp documentation)
-	   (write-string documentation stream))
-	  (documentation
-	   (funcall documentation stream))
-	  (t
-	   (write-string "Execute this command button" stream)))))
+           (write-string documentation stream))
+          (documentation
+           (funcall documentation stream))
+          (t
+           (write-string "Execute this command button" stream)))))
 
 
 ;;; One-of and Some-of choices display
@@ -1185,11 +1189,11 @@
 
 (defun avv-choose-one-of-1 (choice)
   (let* ((choices (accept-values-multiple-choice-choices choice))
-	 (query (accept-values-multiple-choices-query-identifier choices)))
+         (query (accept-values-multiple-choices-query-identifier choices)))
     (setf (accept-values-query-value query)
-	  (funcall (accept-values-multiple-choices-select-action choices)
-		   (accept-values-multiple-choice-value choice)
-		   (accept-values-query-value query)))
+          (funcall (accept-values-multiple-choices-select-action choices)
+                   (accept-values-multiple-choice-value choice)
+                   (accept-values-query-value query)))
     (setf (accept-values-query-changed-p query) t)))
 
 (define-presentation-to-command-translator avv-choose-one-of
@@ -1197,21 +1201,21 @@
      :documentation "Select this value"
      :pointer-documentation "Select this value"
      :tester ((object presentation)
-	      (accept-values-query-valid-p
-		(accept-values-multiple-choices-query-identifier
-		  (accept-values-multiple-choice-choices object))
-		presentation))
+              (accept-values-query-valid-p
+                (accept-values-multiple-choices-query-identifier
+                  (accept-values-multiple-choice-choices object))
+                presentation))
      :echo nil :maintain-history nil
      :gesture :select)
     (object)
   (list object))
 
 (defun accept-values-choose-from-sequence (stream sequence key selected-value tester
-					   type query-identifier
-					   select-action highlighting-function)
+                                           type query-identifier
+                                           select-action highlighting-function)
   (declare (dynamic-extent select-action highlighting-function))
   (flet ((presenter (thing stream)
-	   (present thing type :stream stream)))
+           (present thing type :stream stream)))
     (declare (dynamic-extent #'presenter))
     (accept-values-choose-from-sequence-1
       stream sequence key selected-value tester
@@ -1220,38 +1224,38 @@
       'accept-values-one-of #'presenter)))
 
 (defun accept-values-choose-from-sequence-1 (stream sequence key selected-value tester
-					     type query-identifier
-					     select-action highlighting-function
-					     choice-type choice-presenter)
+                                             type query-identifier
+                                             select-action highlighting-function
+                                             choice-type choice-presenter)
   (declare (dynamic-extent select-action highlighting-function tester choice-presenter))
   (declare (ignore type))
   ;;--- Unfortunately, this makes a new object every time we go around...
   (let ((choices (make-accept-values-multiple-choices
-		   :query-identifier query-identifier
-		   :select-action select-action)))
+                   :query-identifier query-identifier
+                   :select-action select-action)))
     (flet ((print-choice (object stream)
-	     (let* ((value (funcall key object))
-		    (selected-p (funcall tester value selected-value)))
-	       (updating-output (stream :unique-id object
-					:cache-value selected-p)
-		 (with-output-as-presentation
-		     (stream
-		      (make-accept-values-multiple-choice :choices choices :value value)
-		      choice-type)
-		   (formatting-cell (stream)
-		     (if selected-p
-			 (funcall highlighting-function choice-presenter value stream)
-			 (funcall choice-presenter value stream))))))))
+             (let* ((value (funcall key object))
+                    (selected-p (funcall tester value selected-value)))
+               (updating-output (stream :unique-id object
+                                        :cache-value selected-p)
+                 (with-output-as-presentation
+                     (stream
+                      (make-accept-values-multiple-choice :choices choices :value value)
+                      choice-type)
+                   (formatting-cell (stream)
+                     (if selected-p
+                         (funcall highlighting-function choice-presenter value stream)
+                         (funcall choice-presenter value stream))))))))
       (declare (dynamic-extent #'print-choice))
       ;; :MAX-WIDTH makes it use as few rows as will fit in the available width.
       ;; :X-SPACING makes it not spread the choices to fill the whole width.
       ;; :INITIAL-SPACING NIL makes it not add whitespace at the start of the field.
       (formatting-item-list (stream :max-width (- (stream-text-margin stream)
-						  (stream-cursor-position stream))
-				    :x-spacing '(2 :character)
-				    :initial-spacing nil)
-	(doseq (object sequence)
-	  (print-choice object stream))))))
+                                                  (stream-cursor-position stream))
+                                    :x-spacing '(2 :character)
+                                    :initial-spacing nil)
+        (doseq (object sequence)
+          (print-choice object stream))))))
 
 (define-accept-values-command com-avv-choose-some-of
     ((choice 'accept-values-some-of))
@@ -1259,17 +1263,17 @@
 
 (defun avv-choose-some-of-1 (choice)
   (let* ((choices (accept-values-multiple-choice-choices choice))
-	 (query (accept-values-multiple-choices-query-identifier choices)))
+         (query (accept-values-multiple-choices-query-identifier choices)))
     (let ((new-value (funcall (accept-values-multiple-choices-select-action choices)
-			      (accept-values-multiple-choice-value choice)
-			      (accept-values-query-value query))))
+                              (accept-values-multiple-choice-value choice)
+                              (accept-values-query-value query))))
       (if (member new-value (accept-values-query-value query))
-	  ;; Use REMOVE instead of DELETE so the the new value is not EQ
-	  ;; to the old one.  If it were to stay EQ, the field would not
-	  ;; be properly redisplayed.
-	  (setf (accept-values-query-value query)
-		(remove new-value (accept-values-query-value query)))
-	  (push new-value (accept-values-query-value query))))
+          ;; Use REMOVE instead of DELETE so the the new value is not EQ
+          ;; to the old one.  If it were to stay EQ, the field would not
+          ;; be properly redisplayed.
+          (setf (accept-values-query-value query)
+                (remove new-value (accept-values-query-value query)))
+          (push new-value (accept-values-query-value query))))
     (setf (accept-values-query-changed-p query) t)))
 
 (define-presentation-to-command-translator avv-choose-some-of
@@ -1277,25 +1281,25 @@
      :documentation "De/Select this value"
      :pointer-documentation "De/Select this value"
      :tester ((object presentation)
-	      (accept-values-query-valid-p
-		(accept-values-multiple-choices-query-identifier
-		  (accept-values-multiple-choice-choices object))
-		presentation))
+              (accept-values-query-valid-p
+                (accept-values-multiple-choices-query-identifier
+                  (accept-values-multiple-choice-choices object))
+                presentation))
      :gesture :select)
     (object)
   (list object))
 
 (defun accept-values-choose-from-subset (stream sequence key selected-value tester
-					 type query-identifier
-					 select-action highlighting-function)
+                                         type query-identifier
+                                         select-action highlighting-function)
   (declare (dynamic-extent select-action highlighting-function))
   (flet ((presenter (thing stream)
-	   (present (list thing) type :stream stream)))
+           (present (list thing) type :stream stream)))
     (declare (dynamic-extent #'presenter))
     (accept-values-choose-from-sequence-1
       stream sequence key selected-value
       #'(lambda (object sequence)
-	  (member object sequence :test tester))
+          (member object sequence :test tester))
       type query-identifier
       select-action highlighting-function
       'accept-values-some-of #'presenter)))
@@ -1313,58 +1317,58 @@
       (setf (frame-pane-to-avv-stream-table frame) (make-hash-table))))
 
 (defun accept-values-pane-displayer (frame pane
-				     &key displayer
-					  resynchronize-every-pass
-					  (check-overlapping t)
-					  view
-					  align-prompts
-					  max-height max-width)
+                                     &key displayer
+                                          resynchronize-every-pass
+                                          (check-overlapping t)
+                                          view
+                                          align-prompts
+                                          max-height max-width)
   (declare (ignore max-height max-width))
   (setq align-prompts (ecase align-prompts
-			((t :right) :right)
-			((:left) :left)
-			((nil) nil)))
+                        ((t :right) :right)
+                        ((:left) :left)
+                        ((nil) nil)))
   (let* ((stream-and-record
-	  (and (not *frame-layout-changing-p*)
-	       (gethash pane (get-frame-pane-to-avv-stream-table frame))))
-	 (avv-stream (car stream-and-record))
-	 (avv-record (cdr stream-and-record)))
+          (and (not *frame-layout-changing-p*)
+               (gethash pane (get-frame-pane-to-avv-stream-table frame))))
+         (avv-stream (car stream-and-record))
+         (avv-record (cdr stream-and-record)))
     (cond ((and avv-stream
-		(output-record-stream avv-record))
-	   (with-deferred-gadget-updates
-	     (letf-globally (((stream-default-view avv-stream)
-			      (or view
-				  (frame-manager-dialog-view (frame-manager frame)))))
-	       (redisplay avv-record avv-stream :check-overlapping check-overlapping)
-	       (when resynchronize-every-pass
-		 (redisplay avv-record avv-stream :check-overlapping check-overlapping)))))
-	  (t
-	   (accept-values-pane-displayer-1 frame pane displayer
-					   align-prompts view)))))
+                (output-record-stream avv-record))
+           (with-deferred-gadget-updates
+             (letf-globally (((stream-default-view avv-stream)
+                              (or view
+                                  (frame-manager-dialog-view (frame-manager frame)))))
+               (redisplay avv-record avv-stream :check-overlapping check-overlapping)
+               (when resynchronize-every-pass
+                 (redisplay avv-record avv-stream :check-overlapping check-overlapping)))))
+          (t
+           (accept-values-pane-displayer-1 frame pane displayer
+                                           align-prompts view)))))
 
 (defun accept-values-pane-displayer-1 (frame pane displayer align-prompts view)
   (let ((avv-stream (make-instance 'accept-values-stream
-				   :stream pane :align-prompts align-prompts))
-	(avv-record nil)
-	(view (or view
-		  (frame-manager-dialog-view (frame-manager frame)))))
+                                   :stream pane :align-prompts align-prompts))
+        (avv-record nil)
+        (view (or view
+                  (frame-manager-dialog-view (frame-manager frame)))))
     (setf (slot-value avv-stream 'avv-frame) frame)
     (letf-globally (((stream-default-view pane)
-		     view))
+                     view))
       (setq avv-record
-	(updating-output (avv-stream)
-	  (with-new-output-record
-	      (avv-stream 'accept-values-output-record avv-record)
-	    (setf (slot-value avv-stream 'avv-record) avv-record)
-	    (if align-prompts
-		(formatting-table (avv-stream)
-		  (funcall displayer frame avv-stream))
-	      (progn
-		(display-view-background avv-stream view)
-		(funcall displayer frame avv-stream)))))))
+        (updating-output (avv-stream)
+          (with-new-output-record
+              (avv-stream 'accept-values-output-record avv-record)
+            (setf (slot-value avv-stream 'avv-record) avv-record)
+            (if align-prompts
+                (formatting-table (avv-stream)
+                  (funcall displayer frame avv-stream))
+              (progn
+                (display-view-background avv-stream view)
+                (funcall displayer frame avv-stream)))))))
     (unless *sizing-application-frame*
       (setf (gethash pane (get-frame-pane-to-avv-stream-table frame))
-	(cons avv-stream avv-record)))))
+        (cons avv-stream avv-record)))))
 
 
 (define-command (com-edit-avv-pane-choice :command-table accept-values-pane)
@@ -1378,8 +1382,8 @@
      :pointer-documentation "Edit this field"
      :gesture :edit-field
      :tester ((object presentation)
-	      (accept-values-query-valid-p object presentation))
-     :priority 1	;prefer this to IDENTITY when in COMMAND-OR-FORM context
+              (accept-values-query-valid-p object presentation))
+     :priority 1        ;prefer this to IDENTITY when in COMMAND-OR-FORM context
      ;; Echoing this is annoying, as is putting it into the command history
      :echo nil :maintain-history nil)
     (object window)
@@ -1389,7 +1393,7 @@
     ((choice 'accept-values-choice)
      (pane 't))
   (accept-values-query-edit-value choice (car (gethash pane (get-frame-pane-to-avv-stream-table (pane-frame pane))))
-			:modify t))
+                        :modify t))
 
 (define-presentation-to-command-translator modify-avv-pane-choice
     (accept-values-choice com-modify-avv-pane-choice accept-values-pane
@@ -1397,8 +1401,8 @@
      :pointer-documentation "Modify this field"
      :gesture :modify-field
      :tester ((object presentation)
-	      (accept-values-query-valid-p object presentation))
-     :priority 1	;prefer this to IDENTITY when in COMMAND-OR-FORM context
+              (accept-values-query-valid-p object presentation))
+     :priority 1        ;prefer this to IDENTITY when in COMMAND-OR-FORM context
      :echo nil :maintain-history nil)
     (object window)
   (list object window))
@@ -1412,9 +1416,9 @@
      :documentation "Remove this field"
      :pointer-documentation "Remove this field"
      :tester ((object presentation)
-	      (accept-values-query-valid-p object presentation))
+              (accept-values-query-valid-p object presentation))
      :gesture :delete-field
-     :priority 1	;prefer this to IDENTITY when in COMMAND-OR-FORM context
+     :priority 1        ;prefer this to IDENTITY when in COMMAND-OR-FORM context
      :echo nil :maintain-history nil)
     (object)
   (list object))
@@ -1425,19 +1429,19 @@
   (funcall (slot-value button 'continuation))
   (when (slot-value button 'resynchronize)
     (let* ((stream-and-record (and (not *frame-layout-changing-p*)
-				   (gethash pane (get-frame-pane-to-avv-stream-table (pane-frame pane)))))
-	   (avv-stream (car stream-and-record))
-	   (avv-record (cdr stream-and-record)))
+                                   (gethash pane (get-frame-pane-to-avv-stream-table (pane-frame pane)))))
+           (avv-stream (car stream-and-record))
+           (avv-record (cdr stream-and-record)))
       (when avv-stream
-	(letf-globally (((stream-default-view avv-stream) +textual-dialog-view+))
-	  (redisplay avv-record avv-stream))))))
+        (letf-globally (((stream-default-view avv-stream) +textual-dialog-view+))
+          (redisplay avv-record avv-stream))))))
 
 (define-presentation-to-command-translator avv-pane-command-button
     (accept-values-command-button com-avv-pane-command-button accept-values-pane
      :documentation document-command-button
      :pointer-documentation document-command-button
      :gesture :select
-     :priority 1	;prefer this to IDENTITY when in COMMAND-OR-FORM context
+     :priority 1        ;prefer this to IDENTITY when in COMMAND-OR-FORM context
      :echo nil :maintain-history nil)
     (object window)
   (list object window))
@@ -1451,7 +1455,7 @@
      :documentation "Select this value"
      :pointer-documentation "Select this value"
      :gesture :select
-     :priority 1	;prefer this to IDENTITY when in COMMAND-OR-FORM context
+     :priority 1        ;prefer this to IDENTITY when in COMMAND-OR-FORM context
      :echo nil :maintain-history nil)
     (object)
   (list object))
@@ -1465,7 +1469,7 @@
      :documentation "De/Select this value"
      :pointer-documentation "De/Select this value"
      :gesture :select
-     :priority 1	;prefer this to IDENTITY when in COMMAND-OR-FORM context
+     :priority 1        ;prefer this to IDENTITY when in COMMAND-OR-FORM context
      :echo nil :maintain-history nil)
     (object)
   (list object))
@@ -1479,34 +1483,34 @@
   (let ((labels (frame-manager-exit-box-labels (frame-manager frame) frame view)))
     (with-slots (exit-boxes) frame
       (updating-output (stream :unique-id stream
-			       :cache-value 'exit-boxes)
-	(formatting-table (stream :equalize-column-widths nil)
-	  (dolist (exit-box exit-boxes)
-	    (with-exit-box-decoded (value label text-style documentation show-as-default)
-	      exit-box labels
-	      (when label
-		(when text-style
-		  (setq text-style `(:text-style ,text-style)))
-		(formatting-column (stream)
-		  (formatting-cell (stream)
-		    (with-output-as-gadget (stream)
-		      (apply #'make-pane 'push-button
-			     :label label
-			     :help-callback documentation
-			     :client frame :id value
-			     :activate-callback #'handle-exit-box-callback
-			     :name :accept-values-exit-button
-			     :show-as-default show-as-default
-			     text-style))))))))))))
+                               :cache-value 'exit-boxes)
+        (formatting-table (stream :equalize-column-widths nil)
+          (dolist (exit-box exit-boxes)
+            (with-exit-box-decoded (value label text-style documentation show-as-default)
+              exit-box labels
+              (when label
+                (when text-style
+                  (setq text-style `(:text-style ,text-style)))
+                (formatting-column (stream)
+                  (formatting-cell (stream)
+                    (with-output-as-gadget (stream)
+                      (apply #'make-pane 'push-button
+                             :label label
+                             :help-callback documentation
+                             :client frame :id value
+                             :activate-callback #'handle-exit-box-callback
+                             :name :accept-values-exit-button
+                             :show-as-default show-as-default
+                             text-style))))))))))))
 
 (defun handle-exit-box-callback (gadget)
   (if *editting-field-p*
       (beep)
     (let ((id (gadget-id gadget)))
       (case id
-	(:exit (com-exit-avv))
-	(:abort (com-abort-avv))
-	(t (funcall id))))))
+        (:exit (com-exit-avv))
+        (:abort (com-abort-avv))
+        (t (funcall id))))))
 
 ;; It's OK that this is only in the ACCEPT-VALUES command table because
 ;; we're going to execute it manually in the callbacks below
@@ -1515,7 +1519,7 @@
      (new-value t))
   (with-slots (value changed-p) query
     (setf value new-value
-	  changed-p t)))
+          changed-p t)))
 
 (defmethod accept-values-value-changed-callback ((gadget value-gadget) new-value stream query)
   (when (accept-values-query-valid-p query (accept-values-query-presentation query))
@@ -1527,11 +1531,11 @@
     (process-command-event
       sheet
       (allocate-event 'presentation-event
-	:sheet sheet
-	:echo nil
-	:presentation-type 'command
-	:value `(com-change-query ,query ,new-value)
-	:frame (slot-value client 'avv-frame)))))
+        :sheet sheet
+        :echo nil
+        :presentation-type 'command
+        :value `(com-change-query ,query ,new-value)
+        :frame (slot-value client 'avv-frame)))))
 
 (defmethod accept-values-value-changed-callback ((gadget radio-box) new-value stream query-id)
   (call-next-method gadget (gadget-id new-value) stream query-id))
@@ -1549,114 +1553,114 @@
     (stream continuation view prompt
      &rest options
      &key (documentation (if (stringp prompt)
-			     prompt
-			   ;;-- What is the right thing to do?
-			   (ignore-errors
-			    (with-output-to-string (stream)
-			      (funcall prompt stream)))))
-	  (query-identifier (list ':button documentation))
+                             prompt
+                           ;;-- What is the right thing to do?
+                           (ignore-errors
+                            (with-output-to-string (stream)
+                              (funcall prompt stream)))))
+          (query-identifier (list ':button documentation))
      &allow-other-keys)
   (typecase view
     (null)
     (symbol (setq view (make-instance view)))
     (cons   (setq view (apply #'make-instance view))))
   (apply #'invoke-accept-values-command-button-1
-	 stream
-	 continuation
-	 (decode-indirect-view
-	  'accept-values-command-button
-	  view
-	  (frame-manager stream)
-	  :query-identifier query-identifier)
-	 prompt
-	 :documentation documentation
-	 :query-identifier query-identifier
-	 options))
+         stream
+         continuation
+         (decode-indirect-view
+          'accept-values-command-button
+          view
+          (frame-manager stream)
+          :query-identifier query-identifier)
+         prompt
+         :documentation documentation
+         :query-identifier query-identifier
+         options))
 
 (define-presentation-method decode-indirect-view
     ((type accept-values-command-button) (view gadget-dialog-view)
-					  (framem standard-frame-manager) &key read-only)
+                                          (framem standard-frame-manager) &key read-only)
   (declare (ignore read-only))
   +push-button-view+)
 
 (defmethod invoke-accept-values-command-button-1
     (stream continuation (view push-button-view) prompt
      &key (documentation (if (stringp prompt)
-			     prompt
-			   ;;-- What is the right thing to do?
-			   (ignore-errors
-			    (with-output-to-string (stream)
-			      (funcall prompt stream)))))
-	  (query-identifier (list ':button documentation))
-	  (cache-value t) (cache-test #'eql)
-	  resynchronize
-	  (active-p t))
+                             prompt
+                           ;;-- What is the right thing to do?
+                           (ignore-errors
+                            (with-output-to-string (stream)
+                              (funcall prompt stream)))))
+          (query-identifier (list ':button documentation))
+          (cache-value t) (cache-test #'eql)
+          resynchronize
+          (active-p t))
   (declare (dynamic-extent prompt))
   (move-cursor-to-view-position stream view)
   (updating-output (stream :unique-id query-identifier :id-test #'equal
-			   :cache-value (cons active-p cache-value)
-			   :cache-test #'(lambda (x y)
-					   (and (eq (car x) (car y))
-						(funcall cache-test (cdr x) (cdr y)))))
+                           :cache-value (cons active-p cache-value)
+                           :cache-test #'(lambda (x y)
+                                           (and (eq (car x) (car y))
+                                                (funcall cache-test (cdr x) (cdr y)))))
     (labels ((update-gadget (record gadget)
-			(declare (ignore record))	     ;;-- This sucks
-			(setf (gadget-label gadget) (compute-prompt))
-			(if active-p
-			    (activate-gadget gadget)
-			  (deactivate-gadget gadget)))
-	     (compute-prompt ()
-	       (if (stringp prompt)
-		   prompt
-		 ;;-- Does this suck or what???
-		 ;;-- If you do a
-		 ;;surrounding-output-with-border without
-		 ;;this write-string output does not get bordered.
-		 (let ((*original-stream* nil))
-		   (pixmap-from-menu-item stream
-					  prompt
-					  #'funcall
-					  nil))))
-	     (doit (stream)
-	       (with-output-as-gadget (stream  :update-gadget #'update-gadget)
-		   (let ((record (stream-current-output-record (encapsulating-stream-stream stream)))
-			 (client (make-instance 'accept-values-command-button
-						:continuation continuation
-						:documentation documentation
-						:resynchronize resynchronize)))
-		     (make-pane-from-view
-		      'push-button
-		      view ()
-		      :id record :client client
-		      :activate-callback #'(lambda (button)
-					     (when (accept-values-query-valid-p nil record) ;---can't be right
-					       (let ((sheet (sheet-parent button)))
-						 (process-command-event
-						  sheet
-						  (allocate-event 'presentation-event
-								  :sheet sheet
-								  :echo nil
-								  :presentation-type 'command
-								  :value `(com-avv-command-button ,client ,record)
-								  :frame *application-frame*)))))
-		      :label (compute-prompt)
-		      :name :accept-values-command-button
-		      :help-callback documentation
-		      :active active-p)))))
+                        (declare (ignore record))            ;;-- This sucks
+                        (setf (gadget-label gadget) (compute-prompt))
+                        (if active-p
+                            (activate-gadget gadget)
+                          (deactivate-gadget gadget)))
+             (compute-prompt ()
+               (if (stringp prompt)
+                   prompt
+                 ;;-- Does this suck or what???
+                 ;;-- If you do a
+                 ;;surrounding-output-with-border without
+                 ;;this write-string output does not get bordered.
+                 (let ((*original-stream* nil))
+                   (apply #'pixmap-from-menu-item
+                          stream prompt #'funcall nil
+                          :gray-out (not active-p)
+                          (view-gadget-initargs view)))))
+             (doit (stream)
+               (with-output-as-gadget (stream  :update-gadget #'update-gadget)
+                   (let ((record (stream-current-output-record (encapsulating-stream-stream stream)))
+                         (client (make-instance 'accept-values-command-button
+                                                :continuation continuation
+                                                :documentation documentation
+                                                :resynchronize resynchronize)))
+                     (make-pane-from-view
+                      'push-button
+                      view ()
+                      :id record :client client
+                      :activate-callback #'(lambda (button)
+                                             (when (accept-values-query-valid-p nil record) ;---can't be right
+                                               (let ((sheet (sheet-parent button)))
+                                                 (process-command-event
+                                                  sheet
+                                                  (allocate-event 'presentation-event
+                                                                  :sheet sheet
+                                                                  :echo nil
+                                                                  :presentation-type 'command
+                                                                  :value `(com-avv-command-button ,client ,record)
+                                                                  :frame *application-frame*)))))
+                      :label (compute-prompt)
+                      :name :accept-values-command-button
+                      :help-callback documentation
+                      :active active-p)))))
       (let ((align-prompts (slot-value stream 'align-prompts)))
-	(if align-prompts
-	    (formatting-row (stream)
-	      (formatting-cell (stream) stream)
-	      (formatting-cell (stream) (doit stream)))
-	  (doit stream))))))
+        (if align-prompts
+            (formatting-row (stream)
+              (formatting-cell (stream) stream)
+              (formatting-cell (stream) (doit stream)))
+          (doit stream))))))
 
 (defmethod frame-manager-position-dialog ((framem standard-frame-manager)
-							  frame
-							  own-window-x-position own-window-y-position)
+                                                          frame
+                                                          own-window-x-position own-window-y-position)
   (multiple-value-bind (x y)
       #+++ignore (pointer-position (port-pointer (port frame)))
       #---ignore (values 100 100)
       (when (and own-window-x-position own-window-y-position)
-	(setq x own-window-x-position
-	      y own-window-y-position))
+        (setq x own-window-x-position
+              y own-window-y-position))
       (position-sheet-carefully
        (frame-top-level-sheet frame) x y)))
diff --git a/clim/drag-and-drop.lisp b/clim/drag-and-drop.lisp
index 125531a97321f5679847f0df8f76a25f7393043f..59e2f5829d789bbb39d7cae5d37e1653ee39fd2e 100644
--- a/clim/drag-and-drop.lisp
+++ b/clim/drag-and-drop.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: drag-and-drop.lisp,v 1.11 93/03/19 09:43:23 cer Exp $
+;; $fiHeader: drag-and-drop.lisp,v 1.12 1993/07/27 01:39:08 colin Exp $
 
 (in-package :clim-internals)
 
@@ -9,6 +9,8 @@
 
 ;;; Direct manipulation ("click and drag", "drag and drop") translators
 
+(defparameter *drag-and-drop-finish-on-release* t)
+
 (defclass drag-and-drop-translator (presentation-translator)
     ((destination-type :initarg :destination-type
 		       :reader presentation-translator-destination-type)
@@ -18,15 +20,18 @@
 		   :reader presentation-translator-highlighting)
      (pointer-cursor :initform nil :initarg :pointer-cursor
 		     :reader presentation-translator-pointer-cursor)
-     ;; The body, tester, and documentation supplied by the programmer.
-     ;; DEFINE-DRAG-AND-DROP-TRANSLATOR uses the other body, tester,
-     ;; and documentaiton slots for its own purposes
+     (finish-on-release :initform *drag-and-drop-finish-on-release*
+			:initarg :finish-on-release
+			:reader presentation-translator-finish-on-release)
+     (destination-tester :initform nil :initarg :destination-tester
+		  :reader presentation-translator-destination-tester)
+     (drag-documentation :initform nil :initarg :drag-documentation
+			 :reader presentation-translator-drag-documentation)
+     ;; The body supplied by the programmer.
+     ;; DEFINE-DRAG-AND-DROP-TRANSLATOR uses the other body slot for
+     ;; its own purposes.
      (real-body :initarg :real-body
-		:reader presentation-translator-real-body)
-     (real-tester :initform nil :initarg :real-tester
-		  :reader presentation-translator-real-tester)
-     (real-documentation :initform nil :initarg :real-documentation
-			 :reader presentation-translator-real-documentation)))
+		:reader presentation-translator-real-body)))
 
 (defmethod print-object ((object drag-and-drop-translator) stream)
   (if *print-escape*
@@ -41,87 +46,82 @@
 (defmacro define-drag-and-drop-translator
 	  (name
 	   (from-type to-type destination-type command-table
-	    &key (gesture ':select) tester
-		 documentation (menu t) priority
-		 feedback highlighting pointer-cursor)
+	    &key (gesture ':select) tester destination-tester
+		 documentation pointer-documentation
+		 drag-documentation (menu t)
+		 priority
+		 (feedback 'frame-drag-and-drop-feedback)
+		 (highlighting 'frame-drag-and-drop-highlighting)
+		 pointer-cursor finish-on-release)
 	   arglist
 	   &body body)
   #+Genera (declare (zwei:indentation 1 3 3 1))
   (with-warnings-for-definition name define-presentation-translator
-    (multiple-value-bind (body-function body-name)
-	(write-translator-function (cons arglist body) name 'real-body
-				   '(destination-object destination-presentation))
-      (multiple-value-bind (tester-function tester-name)
-	  (when tester
-	    (write-translator-function tester name 'real-tester
-				       '(destination-object destination-presentation)))
-	(multiple-value-bind (doc-function doc-name)
-	    (if (stringp documentation)
-		(values nil documentation)
-	        (when documentation
-		  (write-translator-function 
-		    documentation name 'real-doc
-		    '(destination-object destination-presentation stream))))
-	  (multiple-value-bind (feedback-function feedback-name)
-	      (if (symbolp feedback)
-		  (values nil (or feedback 'frame-drag-and-drop-feedback))
-		  (write-drag-and-drop-function 
-		    feedback name 'feedback
-		    '(frame presentation stream initial-x initial-y new-x new-y state)))
-	    (multiple-value-bind (highlighting-function highlighting-name)
-		(if (symbolp highlighting)
-		    (values nil (or highlighting 'frame-drag-and-drop-highlighting))
-		    (write-drag-and-drop-function
-		      highlighting name 'highlighting
-		      '(frame presentation stream state)))
-	      `(progn
-		 (define-presentation-translator-1 ,name
-		     (,from-type ,to-type ,command-table
-		      :gesture ,gesture
-		      :tester nil
-		      :tester-definitive t
-		      :documentation "Drag presentation"
-		      :pointer-documentation "Drag presentation"
-		      :menu ,menu
-		      :priority ,priority
-		      :translator-class drag-and-drop-translator
-		      :destination-type ',destination-type
-		      :real-body ',body-name
-		      :feedback ',feedback-name
-		      :highlighting ',highlighting-name
-		      ,@(when tester `(:real-tester ',tester-name))
-		      ,@(when documentation `(:real-documentation ',doc-name))
-		      :pointer-cursor ',pointer-cursor)
+    (flet ((translator-function-and-name (clause clause-name
+					  &optional args
+						    (use-default-args t)
+						    string-ok)
+	     (when clause
+	       (cond ((or (functionp clause)
+			  (symbolp clause)
+			  (and string-ok (stringp clause)))
+		      (values nil clause))
+		     (t (write-translator-function clause name clause-name args
+						   use-default-args))))))
+      (multiple-value-bind (body-function body-name)
+	  (write-translator-function (cons arglist body) name 'real-body
+				     '(destination-object destination-presentation))
+	(multiple-value-bind (destination-tester-function destination-tester-name)
+	    (translator-function-and-name
+	     destination-tester 'destination-tester
+	     '(destination-object destination-presentation))
+	  (multiple-value-bind (drag-documentation-function drag-documentation-name)
+	      (translator-function-and-name
+	       drag-documentation 'drag-documenation
+	       '(destination-object destination-presentation stream) t t)
+	    (multiple-value-bind (feedback-function feedback-name)
+		(translator-function-and-name
+		 feedback 'feedback
+		 '(frame presentation stream initial-x initial-y new-x new-y state) nil)
+	      (multiple-value-bind (highlighting-function highlighting-name)
+		(translator-function-and-name
+		 highlighting 'highlighting
+		 '(frame presentation stream state) nil)
+		`(progn
+		   (define-presentation-translator-1 ,name
+		       (,from-type ,to-type ,command-table
+				   :gesture ,gesture
+				   :tester ,tester
+				   :tester-definitive t
+				   :documentation ,documentation
+				   :pointer-documentation ,pointer-documentation
+				   :menu ,menu
+				   :priority ,priority
+				   :translator-class drag-and-drop-translator
+				   :destination-type ',destination-type
+				   :real-body ',body-name
+				   :feedback ',feedback-name
+				   :highlighting ',highlighting-name
+				   :pointer-cursor ',pointer-cursor
+				   :finish-on-release ',finish-on-release
+				   :destination-tester ',destination-tester-name
+				   :drag-documentation ',drag-documentation-name)
 		     ,*translator-function-arglist*
-		   (invoke-drag-and-drop-translator ,@*translator-function-arglist*))
-		 ,body-function
-		 ,tester-function
-		 ,doc-function
-		 ,feedback-function
-		 ,highlighting-function))))))))
-
-(defun write-drag-and-drop-function (function translator-name clause-name args)
-  (let ((function-name (gensymbol translator-name clause-name))
-	(arglist (first function))
-	(body (rest function)))
-    (multiple-value-bind (arglist ignores)
-	(canonicalize-and-match-lambda-lists args arglist)
-      (values `(defun ,function-name ,arglist
-		 ,@(and ignores `((declare (ignore ,@ignores))))
-		 ,@body)
-	      function-name))))
-
-(defparameter *drag-and-drop-finish-on-release* nil)
+		     (invoke-drag-and-drop-translator ,@*translator-function-arglist*))
+		   ,body-function
+		   ,destination-tester-function
+		   ,drag-documentation-function
+		   ,feedback-function
+		   ,highlighting-function)))))))))
 
 ;; All the drag-and-drop translators that satisfy the current from-type,
 ;; to-type, and gesture will get here.  However, the translator now being
-;; run is not necessarily the right one.  What we do here is to track the 
+;; run is not necessarily the right one.  What we do here is to track the
 ;; pointer until the destination presentation has been reached, choose the
 ;; correct translator and run it.
+
 (defun invoke-drag-and-drop-translator (object presentation context-type
-					frame event window x y
-					&optional (finish-on-release
-						   *drag-and-drop-finish-on-release*))
+					frame event window x y)
   (catch-abort-gestures ("Abort drag and drop")
     (let* ((command-table (frame-command-table frame))
 	   (translators
@@ -151,6 +151,8 @@
 	   (pointer-cursor
 	    (or (and translators (presentation-translator-pointer-cursor (first translators)))
 		:move))
+	   (finish-on-release
+	    (and translators (presentation-translator-finish-on-release (first translators))))
 	   (pointer (port-pointer (port window)))
 	   (old-pointer-cursor (pointer-cursor pointer))
 	   (initial-x x)
@@ -177,7 +179,7 @@
 			     :key #'presentation-translator-destination-type
 			     :test #'presentation-subtypep-1))
 		      (tester
-		       (and translator (presentation-translator-real-tester translator))))
+		       (and translator (presentation-translator-destination-tester translator))))
 		 (when (or (null tester)
 			   (funcall tester
 				    object presentation context-type
@@ -189,7 +191,7 @@
 	(letf-globally (((pointer-cursor-override pointer) pointer-cursor))
 	  (setf (pointer-cursor pointer) pointer-cursor)
 	  (macrolet ((feedback (window x y state)
-		       `(funcall feedback frame from-presentation ,window 
+		       `(funcall feedback frame from-presentation ,window
 				 initial-x initial-y ,x ,y ,state))
 		     (highlight (presentation window state)
 		       `(when (and ,presentation
@@ -197,91 +199,80 @@
 			  (funcall highlighting frame ,presentation ,window ,state))))
 	    (block drag-presentation
 	      (tracking-pointer (window :context-type `((or ,@destination-types))
-					:multiple-window t :highlight nil)
+					:multiple-window nil :highlight nil)
 		(:presentation-button-press (presentation event)
-					    (unless finish-on-release
-					      (highlight destination last-window :unhighlight)
-					      (setq destination presentation
-						    destination-event event
-						    last-window (event-sheet event)
-						    last-x (pointer-event-x event)
-						    last-y (pointer-event-y event))
-					      (return-from drag-presentation)))
+		 (unless finish-on-release
+		   (setq destination-event event
+			 destination presentation)
+		   (return-from drag-presentation)))
+
 		(:pointer-button-press (event)
-				       (unless finish-on-release
-					 (highlight destination last-window :unhighlight)
-					 (setq destination nil
-					       destination-event event
-					       last-window (event-sheet event)
-					       last-x (pointer-event-x event)
-					       last-y (pointer-event-y event))
-					 (return-from drag-presentation)))
+		 (unless finish-on-release
+		   (setq destination-event event
+			 destination nil)
+		   (return-from drag-presentation)))
+
 		(:presentation-button-release (presentation event)
-					      (when finish-on-release
-						(highlight destination last-window :unhighlight)
-						(setq destination presentation
-						      destination-event event
-						      last-window (event-sheet event)
-						      last-x (pointer-event-x event)
-						      last-y (pointer-event-y event))
-						(return-from drag-presentation)))
+		 (when finish-on-release
+		   (setq destination-event event
+			 destination presentation)
+		   (return-from drag-presentation)))
+
 		(:pointer-button-release (event)
-					 (when finish-on-release
-					   (highlight destination last-window :unhighlight)
-					   (setq destination nil
-						 destination-event event
-						 last-window (event-sheet event)
-						 last-x (pointer-event-x event)
-						 last-y (pointer-event-y event))
-					   (return-from drag-presentation)))
+		 (when finish-on-release
+		   (setq destination-event event
+			 destination nil)
+		   (return-from drag-presentation)))
+
 		(:presentation (presentation window x y)
-			       (when last-x
-				 (feedback last-window last-x last-y :unhighlight))
-			       (setq last-x x
-				     last-y y
-				     last-window window)
-			       (feedback window x y :highlight)
-			       (when (not (eq presentation destination))
-				 (highlight destination last-window :unhighlight)
-				 (setq destination presentation)
-				 (highlight presentation window :highlight)
-				 #+++ignore ;--- documentation
-				 (let ((translator (find-translator destination window x y)))
-				   (when translator
-				     (let ((documentation
-					    (presentation-translator-real-documentation translator)))
-				       (if (stringp documentation)
-					   (write-string documentation doc-stream)
-					 (funcall documentation 
-						  (presentation-object presentation)
-						  presentation context-type
-						  frame event window x y
-						  (presentation-object destination) destination
-						  doc-stream)))))))
+		 (when last-x
+		   (feedback last-window last-x last-y :unhighlight))
+		 (feedback window x y :highlight)
+		 (when (not (eq presentation destination))
+		   (highlight destination last-window :unhighlight)
+		   (let ((translator (find-translator presentation window x y)))
+		     (setq destination (and translator presentation))
+		     (highlight destination window :highlight)
+		     (document-drag-and-drop-translator translator
+							from-presentation destination
+							context-type
+							frame event
+							window x y)))
+		 (setq last-x x last-y y last-window window))
+
 		(:pointer-motion (window x y)
-				 (when (typep window 'clim-stream-sheet)
-				   (highlight destination last-window :unhighlight)
-				   (setq destination nil)
-				   (when last-x
-				     (feedback last-window last-x last-y :unhighlight))
-				   (setq last-x x
-					 last-y y
-					 last-window window)
-				   (feedback window x y :highlight)))))
+		 (when (typep window 'clim-stream-sheet)
+		   (when last-x
+		     (feedback last-window last-x last-y :unhighlight))
+		   (feedback window x y :highlight)
+		   (highlight destination last-window :unhighlight)
+		   (setq destination nil)
+		   (let ((translator (find-translator presentation window x y)))
+		     (document-drag-and-drop-translator translator
+							from-presentation destination
+							context-type
+							frame event
+							window x y))
+		   (setq last-x x last-y y last-window window)))))
+
+	    (highlight destination last-window :unhighlight)
 	    (when last-x
 	      (feedback last-window last-x last-y :unhighlight)))
 	  (setf (pointer-cursor pointer) old-pointer-cursor))
 	;; The user has put down the presentation, figure out what to do
 	;;--- What if there is more than one translator?
-	(unless destination 
+	(unless destination
 	  ;; No destination presentation?  Then use the null presentation
 	  (setq destination *null-presentation*))
-	(let ((translator (find-translator destination last-window last-x last-y)))
+	(let* ((window (event-sheet destination-event))
+	       (x (pointer-event-x destination-event))
+	       (y (pointer-event-y destination-event))
+	       (translator (find-translator destination window x y)))
 	  (when translator
 	    (multiple-value-bind (result-object result-type options)
 		(funcall (presentation-translator-real-body translator)
 			 object presentation context-type
-			 frame event last-window last-x last-y
+			 frame event window x y
 			 (presentation-object destination) destination)
 	      (setq result-type (or result-type (evacuate-list context-type)))
 	      ;; Find the tag to throw to, and do so
@@ -297,17 +288,27 @@
   (throw 'no-translation nil))
 
 ;; NEW-X and NEW-Y are in stream coordinates.
-(defmethod frame-drag-and-drop-feedback 
+(defmethod frame-drag-and-drop-feedback
 	   ((frame standard-application-frame) presentation stream
 	    initial-x initial-y new-x new-y state)
-  (declare (ignore initial-x initial-y state))	;we'll just use XOR
-  (multiple-value-bind (width height) (bounding-rectangle-size presentation)
-    (with-output-recording-options (stream :record nil)
-      (with-identity-transformation (stream)
-	(draw-rectangle* stream new-x new-y (+ new-x width) (+ new-y height)
-			 :filled nil :ink +flipping-ink+ :line-dashes #(4 4))))))
+  (declare (optimize (speed 3) (safety 0) (debug 0)))
+  (declare (ignore state))	;we'll just use XOR
+  (multiple-value-bind (xoff yoff)
+      (convert-from-relative-to-absolute-coordinates
+	stream (output-record-parent presentation))
+    (with-bounding-rectangle* (left top right bottom) presentation
+      (let ((width (- right left))
+	    (height (- bottom top))
+	    (dx (- (+ left xoff) initial-x))
+	    (dy (- (+ top yoff) initial-y)))
+	(with-output-recording-options (stream :record nil)
+	  (with-identity-transformation (stream)
+	    (let ((x (+ new-x dx))
+		  (y (+ new-y dy)))
+	      (draw-rectangle* stream x y (+ x width) (+ y height)
+			       :filled nil :ink +flipping-ink+ :line-dashes #(4 4)))))))))
 
-(defmethod frame-drag-and-drop-highlighting 
+(defmethod frame-drag-and-drop-highlighting
 	   ((frame standard-application-frame) presentation stream state)
   (ecase state
     (:highlight
@@ -315,6 +316,33 @@
     (:unhighlight
       (unhighlight-highlighted-presentation stream))))
 
+;; consider merging this with document-presentation-translator
+;; specifying :documentation-type as :drag-documentation (cim 4/3/96)
+
+(defun document-drag-and-drop-translator
+    (translator from-presentation destination-presentation
+     context-type frame event window x y
+     &key (stream (frame-pointer-documentation-output frame)))
+  (when stream
+    (window-clear stream)
+    (when translator
+      (with-output-recording-options (stream :record nil)
+	(with-end-of-line-action (stream :allow)
+	  (with-end-of-page-action (stream :allow)
+	    (let ((documentation
+		   (presentation-translator-drag-documentation translator)))
+	      (when documentation
+		(if (stringp documentation)
+		    (write-string documentation stream)
+		  (funcall documentation
+			   (presentation-object from-presentation)
+			   from-presentation context-type
+			   frame event window x y
+			   (presentation-object destination-presentation)
+			   destination-presentation
+			   stream))))))))
+    (force-output stream)))
+
 ;; Used to extract all presentations of a certain type in a "surrounded region"
 #+++ignore
 (defun presentations-of-type-in-region (type stream region &optional (sort t))
diff --git a/clim/frames.lisp b/clim/frames.lisp
index 524ab43492db3b37e3a9d4ebff2b615b53ea7d92..263b933b31f9414e74c69e09a767f3499def6ac9 100644
--- a/clim/frames.lisp
+++ b/clim/frames.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: frames.lisp,v 1.81 1996/03/01 05:41:55 colin Exp $
+;; $fiHeader: frames.lisp,v 1.82 1996/03/13 09:55:32 colin Exp $
 
 (in-package :clim-internals)
 
@@ -81,6 +81,9 @@
 				 (find-frame-manager)))
 	(t (find-frame-manager))))
 
+(defmethod frame-manager ((graft graft))
+  (find-frame-manager :port (port graft)))
+
 (defmethod initialize-instance :after ((frame standard-application-frame)
 				       &key
 				       (frame-manager (find-frame-manager))
@@ -403,15 +406,22 @@
     (dolist (x pane-constructors)
       (find-or-make-pane-named frame (car x)))))
 
+;; Many window managers will negotiate correctly with the toolkit to
+;; limit frames to the screen size. For those that don't (notably olwm)
+;; *graft-maximum-size-factor* allows you to control how much of graft
+;; to use. Setting it some value less than 1 will allow you to see the
+;; window manager decoration (which CLIM can't know the size of)
+;; cim 7/12/96
+
+;; Perhaps this should be a slot in the graft and not set globally
+
+(defvar *graft-maximum-size-factor* nil)
+
 (defmacro limit-size-to-graft (width height graft)
   `(multiple-value-bind (graft-width graft-height)
        (bounding-rectangle-size ,graft)
      ;;--- This fudge factor stuff looks dubious  --SWM
-     ;; using 1 works ok by limiting the size of the top level window
-     ;; (not the top level window + frame). As you can't know (I don't
-     ;; think) what the particular wm frame size will be using a hard
-     ;; wired fudge factor of .9 seems ok to me (cim 9/4/95)
-     (let ((fudge-factor #-ignore 0.9 #+ignore 1))
+     (let ((fudge-factor (or *graft-maximum-size-factor* 1)))
        (minf-or ,width (* graft-width fudge-factor))
        (minf-or ,height (* graft-height fudge-factor)))))
 
diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp
index c414fc27ea5a9d625c813734c21a4aa0130c3afa..d0e0f58da676b60d4fb0cb5ade13509cc69adf45 100644
--- a/clim/gadget-output.lisp
+++ b/clim/gadget-output.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gadget-output.lisp,v 1.58 1995/05/17 19:47:55 colin Exp $
+;; $fiHeader: gadget-output.lisp,v 1.59 1995/10/17 05:01:32 colin Exp $
 
 (in-package :clim-internals)
 
@@ -293,9 +293,9 @@
     +radio-box-view+))
 
 (define-presentation-method accept-present-default
-			    ((type completion) stream (view radio-box-view)
-			     default default-supplied-p present-p query-identifier
-			     &key (prompt t) (active-p t))
+    ((type completion) stream (view radio-box-view)
+		       default default-supplied-p present-p query-identifier
+		       &key (prompt t) (active-p t))
   (declare (ignore present-p prompt))
   (move-cursor-to-view-position stream view)
   (let ((current-selection nil))
@@ -304,60 +304,75 @@
 	     ;;--- This sucks
 	     (if active-p
 		 (activate-gadget radio-box)
-		 (deactivate-gadget radio-box))
+	       (deactivate-gadget radio-box))
 	     (map-over-sheets
-	       #'(lambda (sheet)
-		   (when (typep sheet 'toggle-button)
-		     (when (setf (gadget-value sheet)
-				 (and default-supplied-p
-				      (funcall test (gadget-id sheet) default)))
-		       (setf (radio-box-current-selection radio-box) sheet))))
-	       radio-box)))
+	      #'(lambda (sheet)
+		  (when (typep sheet 'toggle-button)
+		    (when (setf (gadget-value sheet)
+			    (and default-supplied-p
+				 (funcall test (gadget-id sheet) default)))
+		      (setf (radio-box-current-selection radio-box) sheet))))
+	      radio-box)))
       (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
 	(let* ((toggle-options
-		 (getf (view-gadget-initargs view) :toggle-button-options))
+		(getf (view-gadget-initargs view) :toggle-button-options))
 	       (radio-box-label
-		 (getf (view-gadget-initargs view) :label))
+		(getf (view-gadget-initargs view) :label))
+	       (label-options
+		(getf (view-gadget-initargs view) :label-options))
+	       (borders
+		(getf (view-gadget-initargs view) :borders t))
 	       (buttons
-		 (map 'list
-		      #'(lambda (element)
-			  (let* ((value (funcall value-key element))
-				 (button
-				  (apply #'make-pane 'toggle-button
-					 :label
-					 (let ((name (funcall name-key element)))
-					   (if (eq printer #'write-token)
-					       name
-					     (pixmap-from-menu-item stream name printer nil)))
-					 :indicator-type
-					 (getf toggle-options :indicator-type :one-of)
-					 :value
-					 (and default-supplied-p
-					      (funcall test value default))
-					 :id value
-					 toggle-options)))
-			    (when (and default-supplied-p
-				       (funcall test value default))
-			      (setq current-selection button))
-			    button))
-		      sequence))
+		(map 'list
+		  #'(lambda (element)
+		      (let* ((value (funcall value-key element))
+			     (button
+			      (apply #'make-pane 'toggle-button
+				     :label
+				     (let ((name (funcall name-key element)))
+				       (if (eq printer #'write-token)
+					   name
+					 (apply #'pixmap-from-menu-item
+						stream name printer nil
+						:gray-out (not active-p)
+						(view-gadget-initargs view))))
+				     :indicator-type
+				     (getf toggle-options :indicator-type :one-of)
+				     :value
+				     (and default-supplied-p
+					  (funcall test value default))
+				     :id value
+				     toggle-options)))
+			(when (and default-supplied-p
+				   (funcall test value default))
+			  (setq current-selection button))
+			button))
+		  sequence))
 	       (radio-box
-		(make-pane-from-view 'radio-box view
-				     '(:toggle-button-options :label)
-		  :choices buttons
-		  :current-selection current-selection
-		  :client stream
-		  :id query-identifier
-		  :value-changed-callback (make-accept-values-value-changed-callback
-					   stream query-identifier)
-		  :active active-p
-		  :help-callback (make-gadget-help type))))
-	  (values (if radio-box-label
-		      (outlining ()
-			(vertically ()
-			  (make-pane 'label-pane :label radio-box-label)
-			  radio-box))
-		      (outlining () radio-box))
+		(make-pane-from-view
+		 'radio-box view
+		 '(:toggle-button-options :label
+		   :label-options :borders)
+		 :choices buttons
+		 :current-selection current-selection
+		 :client stream
+		 :id query-identifier
+		 :value-changed-callback (make-accept-values-value-changed-callback
+					  stream query-identifier)
+		 :active active-p
+		 :help-callback (make-gadget-help type))))
+	  (values (let ((labelled-radio-box
+			 (if radio-box-label
+			     (vertically ()
+			       (apply #'make-pane 'label-pane
+				      :label radio-box-label
+				      label-options)
+			       radio-box)
+			   radio-box)))
+		    (if borders
+			(outlining ()
+			  labelled-radio-box)
+		      labelled-radio-box))
 		  radio-box))))))
 
 
@@ -371,9 +386,9 @@
       +check-box-view+))
 
 (define-presentation-method accept-present-default
-			    ((type subset-completion) stream (view check-box-view)
-			     default default-supplied-p present-p query-identifier
-			     &key (prompt t) (active-p t))
+    ((type subset-completion) stream (view check-box-view)
+			      default default-supplied-p present-p query-identifier
+			      &key (prompt t) (active-p t))
   (declare (ignore present-p prompt))
   (move-cursor-to-view-position stream view)
   (flet ((update-gadget (record gadget check-box)
@@ -381,66 +396,80 @@
 	   ;;--- This sucks
 	   (if active-p
 	       (activate-gadget check-box)
-	       (deactivate-gadget check-box))
+	     (deactivate-gadget check-box))
 	   (let ((current-selection nil))
 	     (map-over-sheets
-	       #'(lambda (sheet)
-		   (when (typep sheet 'toggle-button)
-		     (let ((value
-			     (and default-supplied-p
-				  (member (gadget-id sheet) default
-					  :test test)
-				  t)))
-		       (when value (push sheet current-selection))
-		       (setf (gadget-value sheet) value))))
-	       check-box)
+	      #'(lambda (sheet)
+		  (when (typep sheet 'toggle-button)
+		    (let ((value
+			   (and default-supplied-p
+				(member (gadget-id sheet) default
+					:test test)
+				t)))
+		      (when value (push sheet current-selection))
+		      (setf (gadget-value sheet) value))))
+	      check-box)
 	     (setf (check-box-current-selection check-box) current-selection))))
     (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
       (let* ((toggle-options
-	       (getf (view-gadget-initargs view) :toggle-button-options))
+	      (getf (view-gadget-initargs view) :toggle-button-options))
 	     (check-box-label
-	       (getf (view-gadget-initargs view) :label))
+	      (getf (view-gadget-initargs view) :label))
+	     (label-options
+	      (getf (view-gadget-initargs view) :label-options))
+	     (borders
+	      (getf (view-gadget-initargs view) :borders t))
 	     (current-selection nil)
 	     (buttons
-	       (map 'list
-		    #'(lambda (element)
-			(let* ((value (funcall value-key element))
-			       (actual-value (and default-supplied-p
-						  (member value default
-							  :test test)
-						  t))
-			       (button
-				 (apply #'make-pane 'toggle-button
+	      (map 'list
+		#'(lambda (element)
+		    (let* ((value (funcall value-key element))
+			   (actual-value (and default-supplied-p
+					      (member value default
+						      :test test)
+					      t))
+			   (button
+			    (apply #'make-pane 'toggle-button
 				   :label
-				     (let ((name (funcall name-key element)))
-				       (if (eq printer #'write-token)
-					   name
-					   (pixmap-from-menu-item stream name printer nil)))
+				   (let ((name (funcall name-key element)))
+				     (if (eq printer #'write-token)
+					 name
+				       (apply #'pixmap-from-menu-item
+					      stream name printer nil
+					      :gray-out (not active-p)
+					      (view-gadget-initargs view))))
 				   :indicator-type
-				     (getf toggle-options :indicator-type :some-of)
+				   (getf toggle-options :indicator-type :some-of)
 				   :value actual-value
 				   :id value
 				   toggle-options)))
-			  (when actual-value (push button current-selection))
-			  button))
-		    sequence))
+		      (when actual-value (push button current-selection))
+		      button))
+		sequence))
 	     (check-box
 	      (make-pane-from-view 'check-box view
-				   '(:toggle-button-options :label)
-		:choices buttons
-		:current-selection current-selection
-		:client stream
-		:id query-identifier
-		:value-changed-callback (make-accept-values-value-changed-callback
-					 stream query-identifier)
-		:active active-p
-		:help-callback (make-gadget-help type))))
-	(values (if check-box-label
-		    (outlining ()
-		      (vertically ()
-			(make-pane 'label-pane :label check-box-label)
-			check-box))
-		    (outlining () check-box))
+				   '(:toggle-button-options :label
+				     :label-options :borders)
+				   :choices buttons
+				   :current-selection current-selection
+				   :client stream
+				   :id query-identifier
+				   :value-changed-callback (make-accept-values-value-changed-callback
+							    stream query-identifier)
+				   :active active-p
+				   :help-callback (make-gadget-help type))))
+	(values (let ((labelled-check-box
+		       (if check-box-label
+			   (vertically ()
+			     (apply #'make-pane 'label-pane
+				    :label check-box-label
+				    label-options)
+			     check-box)
+			 check-box)))
+		  (if borders
+		      (outlining ()
+			labelled-check-box)
+		    labelled-check-box))
 		check-box)))))
 
 
@@ -454,9 +483,9 @@
       +toggle-button-view+))
 
 (define-presentation-method accept-present-default
-			    ((type boolean) stream (view toggle-button-view)
-			     default default-supplied-p present-p query-identifier
-			     &key (prompt t) (active-p t))
+    ((type boolean) stream (view toggle-button-view)
+		    default default-supplied-p present-p query-identifier
+		    &key (prompt t) (active-p t))
   (declare (ignore default-supplied-p present-p prompt))
   (move-cursor-to-view-position stream view)
   (flet ((update-gadget (record gadget button)
@@ -464,18 +493,25 @@
 	   ;;--- This sucks
 	   (if active-p
 	       (activate-gadget button)
-	       (deactivate-gadget button))
+	     (deactivate-gadget button))
  	   (setf (gadget-value button) default)))
     (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
-      (let ((button (make-pane-from-view 'toggle-button view ()
-		      :value default
-		      :client stream :id query-identifier
-		      :value-changed-callback
-		        (make-accept-values-value-changed-callback
-			 stream query-identifier)
-		      :active active-p
-		      :help-callback (make-gadget-help type))))
- 	(values (outlining () button) button)))))
+      (let ((borders
+	     (getf (view-gadget-initargs view) :borders t))
+	    (button (make-pane-from-view
+		     'toggle-button view
+		     '(:borders)
+		     :value default
+		     :client stream :id query-identifier
+		     :value-changed-callback
+		     (make-accept-values-value-changed-callback
+		      stream query-identifier)
+		     :active active-p
+		     :help-callback (make-gadget-help type))))
+ 	(values (if borders
+		    (outlining () button)
+		  button)
+		button)))))
 
 
 ;;; Numeric gadgets
@@ -514,23 +550,30 @@
 	     (setf (gadget-value slider)
 		   (if default-supplied-p default min-value))))
       (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
-	(let ((slider
+	(let ((borders
+	       (getf (view-gadget-initargs view) :borders t))
+	      (slider
 		;;--- What other initargs do we pass along from the view?
-		(make-pane-from-view 'slider view ()
-		  :value (if default-supplied-p default min-value)
-		  :min-value min-value :max-value max-value
-		  :orientation (gadget-orientation view)
-		  :decimal-places (or (slider-decimal-places view) 0)
-		  :show-value-p (gadget-show-value-p view)
-		  :client stream :id query-identifier
-		  :value-changed-callback
-		    (and editable-p
-			 (make-accept-values-value-changed-callback
-			   stream query-identifier))
-		  :active active-p
-		  :editable-p editable-p
-		  :help-callback (make-gadget-help type))))
-	  (values (outlining () slider) slider))))))
+	       (make-pane-from-view
+		'slider view
+		'(:borders)
+		:value (if default-supplied-p default min-value)
+		:min-value min-value :max-value max-value
+		:orientation (gadget-orientation view)
+		:decimal-places (or (slider-decimal-places view) 0)
+		:show-value-p (gadget-show-value-p view)
+		:client stream :id query-identifier
+		:value-changed-callback
+		(and editable-p
+		     (make-accept-values-value-changed-callback
+		      stream query-identifier))
+		:active active-p
+		:editable-p editable-p
+		:help-callback (make-gadget-help type))))
+	  (values (if borders
+		      (outlining () slider)
+		    slider)
+		  slider))))))
 
 (define-presentation-method accept-present-default
 			    ((type integer) stream (view slider-view)
@@ -562,28 +605,35 @@
 	     ;;--- This sucks
 	     (if active-p
 		 (activate-gadget slider)
-		 (deactivate-gadget slider))
+	       (deactivate-gadget slider))
 	     (setf (gadget-value slider)
-		   (if default-supplied-p default min-value))))
+	       (if default-supplied-p default min-value))))
       (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
-	(let ((slider
-		;;--- What other initargs do we pass along from the view?
-		(make-pane-from-view 'slider view ()
-		  :value (if default-supplied-p default min-value)
-		  :min-value min-value :max-value max-value
-		  :orientation (gadget-orientation view)
-		  :number-of-quanta (- max-value min-value)
-		  :decimal-places 0
-		  :show-value-p (gadget-show-value-p view)
-		  :client stream :id query-identifier
-		  :value-changed-callback
-		    (and editable-p
-			 (make-accept-values-value-changed-callback
-			   stream query-identifier))
-		  :active active-p
-		  :editable-p editable-p
-		  :help-callback (make-gadget-help type))))
-	  (values (outlining () slider) slider))))))
+	(let ((borders
+	       (getf (view-gadget-initargs view) :borders t))
+	      (slider
+	       ;;--- What other initargs do we pass along from the view?
+	       (make-pane-from-view
+		'slider view
+		'(:borders)
+		:value (if default-supplied-p default min-value)
+		:min-value min-value :max-value max-value
+		:orientation (gadget-orientation view)
+		:number-of-quanta (- max-value min-value)
+		:decimal-places 0
+		:show-value-p (gadget-show-value-p view)
+		:client stream :id query-identifier
+		:value-changed-callback
+		(and editable-p
+		     (make-accept-values-value-changed-callback
+		      stream query-identifier))
+		:active active-p
+		:editable-p editable-p
+		:help-callback (make-gadget-help type))))
+	  (values (if borders
+		      (outlining () slider)
+		    slider)
+		  slider))))))
 
 
 ;;; Text Field gadget
diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp
index a3587f3a2efeca0753c3ff80707172a0af2c017a..4a13f327f1f3d214311b05f6a747abff1416f9f1 100644
--- a/clim/input-protocol.lisp
+++ b/clim/input-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: input-protocol.lisp,v 1.47 1995/05/17 19:48:00 colin Exp $
+;; $fiHeader: input-protocol.lisp,v 1.48 1995/10/17 05:01:36 colin Exp $
 
 (in-package :clim-internals)
 
@@ -126,8 +126,7 @@
 	      (cursor-width-and-height-pending-protocol cursor)
 	    (with-bounding-rectangle* (left top right bottom) region
 	      (when (ltrb-overlaps-ltrb-p left top right bottom
-					  x y (+ x width) (+ y
-							     height))
+					  x y (+ x width) (+ y height))
 		(with-sheet-medium (medium stream)
 		  (with-medium-clipping-region (medium region)
 		    (declare (ignore medium))
diff --git a/clim/interactive-protocol.lisp b/clim/interactive-protocol.lisp
index 0d38983fd9445af7fe1f88a9d8659f918d2294d5..a1608fd120faf35a032a034f11df83b9281d6245 100644
--- a/clim/interactive-protocol.lisp
+++ b/clim/interactive-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: interactive-protocol.lisp,v 1.34 1995/10/20 17:37:37 colin Exp $
+;; $fiHeader: interactive-protocol.lisp,v 1.35 1996/03/01 05:42:07 colin Exp $
 
 (in-package :clim-internals)
 
@@ -20,7 +20,8 @@
 
 ;;; Fake methods to keep things like COMPLETE-INPUT from blowing up on
 ;;; non-input-editing streams like string streams.
-(defmethod stream-scan-pointer ((stream t)) 0)
+(defmethod stream-scan-pointer ((stream t))
+  (file-position stream))
 
 (defmethod (setf stream-scan-pointer) (position (stream t))
   (file-position stream position))
diff --git a/clim/output-protocol.lisp b/clim/output-protocol.lisp
index 8524f7fa303ab1a12dfe02eaa29a6d3bf0e39b4d..c329a7629c360eb3ec70ba69a3ecfd9e27f297eb 100644
--- a/clim/output-protocol.lisp
+++ b/clim/output-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: output-protocol.lisp,v 1.40 1993/09/17 19:05:16 cer Exp $
+;; $fiHeader: output-protocol.lisp,v 1.42 1995/11/23 01:58:37 georgej Exp $
 
 (in-package :clim-internals)
 
@@ -123,6 +123,9 @@
   (with-slots (cursor-x cursor-y) stream
     (values cursor-x cursor-y)))
 
+;;; To make filling-output work on string-streams
+(defmethod stream-cursor-position ((stream t)) 0)
+
 (defmethod stream-set-cursor-position ((stream output-protocol-mixin) x y)
   (with-slots (cursor-x cursor-y current-line-height baseline) stream
     (when x
diff --git a/clim/pixmap-streams.lisp b/clim/pixmap-streams.lisp
index 8b8d5fe1cc1b790d9b2c0b195124455d497725b6..c5f5742c802a3fc07fd7760de338d4974c153eec 100644
--- a/clim/pixmap-streams.lisp
+++ b/clim/pixmap-streams.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: pixmap-streams.lisp,v 1.21 1993/08/12 16:03:11 cer Exp $
+;; $fiHeader: pixmap-streams.lisp,v 1.22 1993/09/17 19:05:19 cer Exp $
 
 (in-package :clim-internals)
 
@@ -33,7 +33,7 @@
       (multiple-value-setq (width height) (bounding-rectangle-size record)))
     (let* ((pixmap-medium (make-pixmap-medium (port stream) stream
 					      :width width :height height))
-	   (pixmap-stream (make-instance 'pixmap-stream 
+	   (pixmap-stream (make-instance 'pixmap-stream
 			    :default-text-margin width
 			    :port (port stream)
 			    :medium pixmap-medium
@@ -54,13 +54,15 @@
       (multiple-value-setq (width height) (bounding-rectangle-size record)))
     (let* ((pixmap-medium (make-pixmap-medium (port stream) stream
 					      :width width :height height))
-	   (pixmap-stream (make-instance 'pixmap-stream 
+	   (pixmap-stream (make-instance 'pixmap-stream
 					 :default-text-margin width
 					 :port (port stream)
 					 :medium pixmap-medium
 					 :width width :height height)))
       (setf (medium-foreground pixmap-medium) (medium-foreground stream)
 	    (medium-background pixmap-medium) (medium-background stream)
+	    ;; Why do we set both medium-default-text-style and
+	    ;; medium-text-style here? (cim 7/1/96)
 	    (medium-default-text-style pixmap-medium) (pane-text-style stream)
 	    (medium-text-style pixmap-medium) (pane-text-style stream))
       (if record
@@ -68,8 +70,12 @@
 	(funcall continuation pixmap-stream))
       (slot-value pixmap-medium 'silica::pixmap))))
 
+(defconstant +gray-out-ink+
+    (compose-in (make-opacity .5) +background-ink+))
+
 (defun pixmap-from-menu-item (associated-window menu-item printer presentation-type
-			      &optional text-style)
+			      &key text-style background foreground gray-out
+			      &allow-other-keys)
   (with-menu (menu associated-window)
     (let ((record (with-output-recording-options (menu :draw nil :record t)
 		    (with-output-to-output-record (menu)
@@ -87,12 +93,19 @@
 	(with-output-to-pixmap (stream associated-window :width width :height height)
 	  (when text-style
 	    (setf (medium-default-text-style stream) text-style))
+	  (when background
+	    (setf (medium-background stream) background))
+	  (when foreground
+	    (setf (medium-foreground stream) foreground))
 	  (draw-rectangle* stream 0 0 width height
 			   :ink +background-ink+ :filled t)
 	  (replay-output-record
 	   record stream +everywhere+
 	   (- (bounding-rectangle-left record))
-	   (- (bounding-rectangle-top record))))))))
+	   (- (bounding-rectangle-top record)))
+	  (when gray-out
+	    (draw-rectangle* stream 0 0 width height
+			     :ink +gray-out-ink+ :filled t)))))))
 
 ;;; This code would be nice to use since it will eliminate the
 ;;; creation of a whole bunch of pixmaps. However, quite often you get
@@ -111,7 +124,7 @@
       (cond ((or (eq class (find-class 'standard-presentation))
 		 (eq class (find-class 'standard-sequence-output-record)))
 	     (if (= (output-record-count record) 1)
-		 (setq record (output-record-element record 0)) 
+		 (setq record (output-record-element record 0))
 	       (return nil)))
 	    ((eq class (find-class 'standard-text-output-record))
 	     (return record))
diff --git a/clim/translators.lisp b/clim/translators.lisp
index ff2afd509cd3930c5f56bf8946a63583502d03b3..4d5aa9e9d957ccb00e698fcee66892bf5eaf11de 100644
--- a/clim/translators.lisp
+++ b/clim/translators.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: translators.lisp,v 1.13 1993/07/27 01:41:46 colin Exp $
+;; $fiHeader: translators.lisp,v 1.14 1995/10/17 05:01:49 colin Exp $
 
 (in-package :clim-internals)
 
@@ -249,13 +249,17 @@
 						      :errorp nil))
       translator)))
 
-(defun write-translator-function (function translator-name clause-name extra-args)
+(defun write-translator-function (function translator-name clause-name
+				  args &optional (use-default-args t))
   (let ((function-name (gensymbol translator-name clause-name))
 	(arglist (first function))
 	(body (rest function)))
     (multiple-value-bind (arglist ignores)
 	(canonicalize-and-match-lambda-lists
-	  (append *translator-function-arglist* extra-args) arglist)
+	 (if use-default-args
+	     (append *translator-function-arglist* args)
+	   args)
+	 arglist)
       (values `(defun ,function-name ,arglist
 		 ,@(and ignores `((declare (ignore ,@ignores))))
 		 ,@body)
diff --git a/demo/listener.lisp b/demo/listener.lisp
index 3e05404b9661ab738dec94e6840d9ecaf02990ee..9ba06e9ff0dc853b66076ebb22366f18a30a2b1c 100644
--- a/demo/listener.lisp
+++ b/demo/listener.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: listener.lisp,v 1.32 1995/05/15 07:17:48 duane Exp $
+;; $fiHeader: listener.lisp,v 1.33 1995/05/17 19:48:42 colin Exp $
 
 (in-package :clim-demo)
 
@@ -11,6 +11,7 @@
   (:command-table (lisp-listener :inherit-from (user-command-table)))
   (:command-definer t)
   (:menu-bar nil)
+  (:pointer-documentation t)
   (:top-level (lisp-listener-top-level))
   (:panes
    (interactor :interactor
diff --git a/misc/compile-1.lisp b/misc/compile-1.lisp
index db18ddf906be4afdc07132a93ba5ff8142ce51ce..30b73cc32f4e489ddc3c44e1aa8d2a7bb3f1bf50 100644
--- a/misc/compile-1.lisp
+++ b/misc/compile-1.lisp
@@ -19,7 +19,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $fiHeader: compile-1.lisp,v 1.29 1995/11/08 06:12:20 georgej Exp $
+;; $fiHeader: compile-1.lisp,v 1.31 1996/03/24 01:52:48 duane Exp $
 
 (in-package :user)
 
@@ -58,7 +58,6 @@
     (tenuring
      (excl:load-system sys))
 
-    #+ics
     (progn
       (excl:compile-system 'wnn :include-components t)
       (excl:load-system 'wnn))
diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp
index 65d9bed050e11911899321560df1e5a5a7cbce90..64769611ff38b7c1b70fb0afbb5f498db19cb798 100644
--- a/silica/gadgets.lisp
+++ b/silica/gadgets.lisp
@@ -1,6 +1,6 @@
 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gadgets.lisp,v 1.60 1995/05/17 19:49:07 colin Exp $
+;; $fiHeader: gadgets.lisp,v 1.61 1995/10/17 05:02:37 colin Exp $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright (c) 1992 by Symbolics, Inc.  All rights reserved."
@@ -343,7 +343,8 @@
 
 (defclass row-column-gadget-mixin (oriented-gadget-mixin)
 	  ((rows :initarg :rows :initform nil :accessor gadget-rows)
-	   (columns :initarg :columns :initform nil :accessor gadget-columns)))
+	   (columns :initarg :columns :initform nil :accessor gadget-columns)
+	   (spacing :initarg :spacing :initform nil :accessor gadget-spacing)))
 
 ;;; Radio box [exclusive-choice] .. [inclusive-choice]
 (defclass radio-box
@@ -760,8 +761,12 @@
     (let* ((items (set-gadget-items sheet))
 	   (total-items (length items))
 	   (visible-items (or (gadget-visible-items sheet)
-			      ;; what's the best default to assume here
-			      1)))
+			      ;; we use +fill+ as the default here so
+			      ;; that we don't try and do any
+			      ;; scrolling if we don't know how many
+			      ;; items are visible ie we assume the
+			      ;; list-pane is infinite (cim 6/24/96)
+			      +fill+)))
       (multiple-value-bind (selected-items m n)
 	  (ecase mode
 	    (:exclusive
@@ -774,8 +779,7 @@
 		 (let ((item (elt items i)))
 		   (when (member (funcall value-key item) value :test test)
 		     (push item selected-items)
-		     (setq m (if m (min m i) i)
-			   n (if n (max n i) i)))))
+		     (setq m (or m i) n i))))
 	       (when selected-items
 		 (values (nreverse selected-items) m n)))))
 	(when selected-items
diff --git a/silica/text-style.lisp b/silica/text-style.lisp
index ddd22a7f046949767ecfd3950d8688a1bb2a6132..e8542a25ba7b6628c394c2c7fb2e03ff8d52690e 100644
--- a/silica/text-style.lisp
+++ b/silica/text-style.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: text-style.lisp,v 1.24 1996/03/01 05:42:55 colin Exp $
+;; $fiHeader: text-style.lisp,v 1.25 1996/03/13 09:55:49 colin Exp $
 
 (in-package :silica)
 
@@ -451,6 +451,21 @@
 (defgeneric text-style-fixed-width-p (text-style medium))
 (defgeneric text-size (medium string &key text-style start end))
 
+(defmethod text-style-height ((style list) medium)
+  (text-style-height (parse-text-style style) medium))
+
+(defmethod text-style-width ((style list) medium)
+  (text-style-width (parse-text-style style) medium))
+
+(defmethod text-style-ascent ((style list) medium)
+  (text-style-ascent (parse-text-style style) medium))
+
+(defmethod text-style-descent ((style list) medium)
+  (text-style-descent (parse-text-style style) medium))
+
+(defmethod text-style-fixed-width-p ((style list) medium)
+  (text-style-fixed-width-p (parse-text-style style) medium))
+
 (defmethod text-size ((medium basic-medium) string
 		      &key (text-style (medium-merged-text-style medium)) (start 0) end)
   (declare (values largest-x total-height last-x last-y baseline))
diff --git a/test/test-clim.lisp b/test/test-clim.lisp
index 922f982b71c95545a30658f6642f930e8da70579..9b6b76609d85065fd7b16a0a5a90c14a4200e5d7 100644
--- a/test/test-clim.lisp
+++ b/test/test-clim.lisp
@@ -19,7 +19,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $fiHeader: test-clim.lisp,v 1.14 1993/10/25 16:16:10 cer Exp $
+;; $fiHeader: test-clim.lisp,v 1.16 1995/11/08 06:13:18 georgej Exp $
 
 
 (in-package :clim-user)
@@ -383,6 +383,14 @@
     (filling-output (*standard-output* :fill-width '(20 :character))
       (write-string *gettysburg-address* *standard-output*))))
 
+(push 'filling-output-on-string-stream-test clim-test:*frame-tests*)
+
+(defun filling-output-on-string-stream-test ()
+  (clim-test:with-test-success-expected ('filling-output-on-string-stream-test)
+    (with-output-to-string (stream)
+      (filling-output (stream :fill-width '(20 :character))
+	(write-string *gettysburg-address* stream)))))
+
 ;;--- This would be nice but the problem occurs in the event handler process
 ;;----
 
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 6a74cbc0f5dee4a08b781d88a6460dd122842c36..d9a152d4c602c882716f043fbcc2960d1fa44cf2 100644
--- a/test/test-suite.lisp
+++ b/test/test-suite.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: test-suite.lisp,v 1.77 1995/10/17 05:02:53 colin Exp $
+;; $fiHeader: test-suite.lisp,v 1.78 1996/03/01 05:43:09 colin Exp $
 
 (in-package :clim-user)
 
@@ -1925,10 +1925,26 @@ Luke Luck licks the lakes Luke's duck likes."))
   :inherit-from 'integer)
 
 (define-drag-and-drop-translator test-suite-dnd
-    (drag-source string drop-target presentations)
-    (presentation destination-presentation)
+    (drag-source string drop-target presentations
+		 :drag-documentation ((object destination-object stream)
+				      (format stream "Drop ~s on ~s" object destination-object))
+		 :documentation "documentation"
+		 :pointer-documentation "pointer-documentation"
+		 :destination-tester ((object destination-object)
+				      (not (eq object destination-object))))
+  (presentation destination-presentation)
   (format nil "Dragged from ~D to ~D"
-    (presentation-object presentation) (presentation-object destination-presentation)))
+	  (presentation-object presentation) (presentation-object
+					      destination-presentation)))
+
+
+(define-drag-and-drop-translator test-suite-dnd-blank
+    (drag-source string drop-target presentations
+		 :drag-documentation "Don't drop now"
+		 :pointer-documentation "bar bar"
+		 :documentation "Documentatoin")
+  ()
+  (format nil "Dragged to blank area"))
 
 (define-test (drag-and-drop-tests presentations) (stream)
   "Try drag and drop"
@@ -2319,6 +2335,38 @@ Luke Luck licks the lakes Luke's duck likes."))
 	      (5.0 float)
 	      (1 integer))))))))
 
+(define-test (gadget-resource-dialog menus-and-dialogs) (stream)
+  "Test gadgets with non-default background, text-style + printer"
+  (let ((printer #'princ)
+	(background +red+)
+	(text-style (make-text-style :sans-serif :italic :large)))
+    (accepting-values (stream)
+      (accept `((member a b c) :printer ,printer)
+	      :stream stream :prompt "X"
+	      :view `(radio-box-view :background ,background
+				     :text-style ,text-style))
+      (terpri stream)
+      (accept `((subset a b c) :printer ,printer)
+	      :stream stream :prompt "Y"
+	      :view `(check-box-view :background ,background
+				     :text-style ,text-style))
+      (terpri stream)
+      (accept `((member p q r) :printer ,printer)
+	      :stream stream :prompt "Z"
+	      :view `(option-pane-view :background ,background
+				       :text-style ,text-style))
+      (terpri stream)
+      (accept-values-command-button
+	  (stream
+	   :view `(push-button-view :background ,background
+				    :text-style ,text-style))
+	  (funcall printer 'hello stream)
+	(menu-choose '(a b c) :printer printer
+		     :background background
+		     :text-style text-style)))))
+
+
+
 (defun gadgets-dialog-internal (stream &optional own-window)
   (macrolet ((accepts (&rest accepts)
 	       `(progn
@@ -3489,7 +3537,8 @@ Luke Luck licks the lakes Luke's duck likes."))
 		 (make-instance (clim-tests-history-class *application-frame*))))
   (:layouts
     (:default
-      (vertically () caption-pane display-pane))))
+      (vertically () caption-pane display-pane)))
+  (:pointer-documentation t))
 
 (defmethod frame-standard-output ((frame clim-tests))
   (get-frame-pane frame 'display-pane))
@@ -3509,3 +3558,4 @@ Luke Luck licks the lakes Luke's duck likes."))
 
 
 
+
diff --git a/tk-silica/xm-dialogs.lisp b/tk-silica/xm-dialogs.lisp
index 3238c644d93db97f08fe6fb15f5d1746326a54aa..b17eb87ad0fcb444170648d3a054406c952f9ec3 100644
--- a/tk-silica/xm-dialogs.lisp
+++ b/tk-silica/xm-dialogs.lisp
@@ -19,7 +19,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $fiHeader: xm-dialogs.lisp,v 1.10 1995/11/08 06:15:52 georgej Exp $
+;; $fiHeader: xm-dialogs.lisp,v 1.11 1996/03/01 05:44:07 colin Exp $
 
 (in-package :clim-internals)
 
@@ -36,7 +36,8 @@
 	      :output-record
 	      (make-instance 'standard-sequence-output-history)
 	      :initial-cursor-visibility :off
-	      :scroll-bars scroll-bars))
+	      :scroll-bars scroll-bars
+	      :end-of-page-action :allow))
 	   (make-pane 'silica::separator :orientation :horizontal)
 	   (setf exit-button-stream
 	     (make-pane 'clim-stream-pane
diff --git a/tk-silica/xm-frames.lisp b/tk-silica/xm-frames.lisp
index 4f2f915b7050a35d5c7a274ee4d9732521d9b65a..d425718382f0d06c80dfa044bd9f33ba83b28ffe 100644
--- a/tk-silica/xm-frames.lisp
+++ b/tk-silica/xm-frames.lisp
@@ -17,7 +17,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $fiHeader: xm-frames.lisp,v 1.71 1995/11/08 06:15:55 georgej Exp $
+;; $fiHeader: xm-frames.lisp,v 1.72 1996/03/01 05:44:09 colin Exp $
 
 (in-package :xm-silica)
 
@@ -434,10 +434,11 @@
 		      (text-style (if item-text-style
 				      (merge-text-styles item-text-style menu-text-style)
 				    menu-text-style))
+		      (sensitive (clim-internals::menu-item-active item))
 		      (button
 		       (if simplep
 			   (apply #'make-instance class
-				  :sensitive (clim-internals::menu-item-active item)
+				  :sensitive sensitive
 				  :parent parent
 				  :managed nil
 				  :label-string (princ-to-string (menu-item-display item))
@@ -451,10 +452,13 @@
 					 item
 					 printer
 					 presentation-type
-					 text-style))
+					 :text-style text-style
+					 :background background
+					 :foreground foreground
+					 :gray-out (not sensitive)))
 				(button
 				 (apply #'make-instance class
-					:sensitive (clim-internals::menu-item-active item)
+					:sensitive sensitive
 					:parent parent
 					:label-type :pixmap
 					:label-pixmap pixmap
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index 3040ec1d986598c73f1dc1c262b933e696603208..8ea051897bf9fe8e542214b8457b910ec3d87c46 100644
--- a/tk-silica/xm-gadgets.lisp
+++ b/tk-silica/xm-gadgets.lisp
@@ -17,7 +17,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $fiHeader: xm-gadgets.lisp,v 1.92 1996/03/01 05:44:12 colin Exp $
+;; $fiHeader: xm-gadgets.lisp,v 1.93 1996/03/13 09:56:11 colin Exp $
 
 (in-package :xm-silica)
 
@@ -189,7 +189,8 @@
       ((or null string)
        (with-sheet-medium (medium sheet)
 	 (multiple-value-setq (width height)
-	   (text-size medium label :text-style (pane-text-style sheet)))))
+	   (text-size medium label
+		      :text-style (pane-text-style sheet)))))
       (tk::pixmap
        (setq width (xt::pixmap-width label)
 	     height (xt::pixmap-height label)))
@@ -1076,17 +1077,21 @@
 						    (parent t)
 						    (sheet motif-row-column-gadget-mixin))
   (let ((initargs (call-next-method))
-	(x (ecase (gadget-orientation sheet)
-	     (:vertical (or (gadget-columns sheet)
-			    (and (silica::gadget-rows sheet)
+	(columns
+	 (ecase (gadget-orientation sheet)
+	   (:vertical (or (gadget-columns sheet)
+			  (and (silica::gadget-rows sheet)
+			       (ceiling (length (sheet-children sheet))
+					(silica::gadget-rows sheet)))))
+	   (:horizontal (or (silica::gadget-rows sheet)
+			    (and (silica::gadget-columns sheet)
 				 (ceiling (length (sheet-children sheet))
-					  (silica::gadget-rows sheet)))))
-	     (:horizontal (or (silica::gadget-rows sheet)
-			      (and (silica::gadget-columns sheet)
-				   (ceiling (length (sheet-children sheet))
-					    (silica::gadget-columns sheet))))))))
-    (when x
-      (setf (getf initargs :num-columns) x))
+					  (silica::gadget-columns sheet)))))))
+	(spacing (silica::gadget-spacing sheet)))
+    (when columns
+      (setf (getf initargs :num-columns) columns))
+    (when spacing
+      (setf (getf initargs :spacing) spacing))
     initargs))
 
 ;;;
@@ -1343,19 +1348,15 @@
 	       (and (typep p 'motif-scroller-pane)
 		    (scroller-pane-scroll-bar-policy p)))))
 	`(:list-size-policy
-	  #-ignore
 	  ,(case scroll-mode
+	     ;; specifying the list-size-policy as :variable is the
+	     ;; only way of getting only vertical scroll-bars
 	     (:vertical :variable)
 	     (t :constant))
-	  #+ignore ;; this one required for buggy pre motif-1.2.4
-	  ,(case scroll-mode
-	     ((:horizontal t :both) :constant)
-	     (t :variable))
 	  :scroll-bar-display-policy
 	  ,(case scroll-mode
 	     ((:horizontal :vertical t :both) :static)
-	     (t :as-needed)
-	     :as-needed)
+	     (t :as-needed))
 	  ,@(and selected-items
 		 `(:selected-item-count ,(length selected-items)
 		   :selected-items ,selected-items
@@ -1368,6 +1369,12 @@
 	  :items ,(mapcar name-key items)
 	  :item-count ,(length items))))))
 
+(defmethod gadget-visible-items ((gadget motif-list-pane))
+  (let ((m (sheet-direct-mirror gadget)))
+    (if m
+	(tk::get-values m :visible-item-count)
+      (call-next-method))))
+
 (defmethod (setf set-gadget-items) :after (items (gadget motif-list-pane))
   ;;---- What should this do about selected items and the value etc etc
   (let ((m (sheet-direct-mirror gadget)))
@@ -1457,18 +1464,21 @@
 		    (let* ((name (funcall name-key item))
 			   (pixmap (unless (or (null printer) (eq printer #'write-token))
 				     (pixmap-from-menu-item
-				      (sheet-parent sheet) name printer nil)))
+				      (sheet-parent sheet) name printer nil
+				      :text-style (pane-text-style sheet)
+				      :background (pane-background sheet)
+				      :foreground (pane-foreground sheet))))
 			   (button
 			    (if (null pixmap)
 				(apply #'make-instance 'tk::xm-push-button
-				  :label-string name
-				  :parent pdm
-				  initargs)
+				       :label-string name
+				       :parent pdm
+				       initargs)
 			      (apply #'make-instance 'tk::xm-push-button
-				:label-pixmap pixmap
-				:label-type :pixmap
-				:parent pdm
-				initargs))))
+				     :label-pixmap pixmap
+				     :label-type :pixmap
+				     :parent pdm
+				     initargs))))
 		      (tk::add-callback
 		       button
 		       :activate-callback
@@ -1509,21 +1519,24 @@
 			  :font-list))
     mirror))
 
-(defun set-option-menu-value (gadget nv)
+(defun set-option-menu-value (sheet nv)
   (with-accessors ((items set-gadget-items)
                    (value-key set-gadget-value-key)
                    (test set-gadget-test)
                    (printer silica::option-pane-printer)
-                   (name-key set-gadget-name-key)) gadget
-    (when (sheet-direct-mirror gadget)
+                   (name-key set-gadget-name-key)) sheet
+    (when (sheet-direct-mirror sheet)
       (let* ((x (position nv items :test test :key value-key))
-             (widget (sheet-direct-mirror gadget)))
+             (widget (sheet-direct-mirror sheet)))
         (when x
-          (tk::set-values widget :menu-history (nth x (motif-option-menu-buttons gadget)))
+          (tk::set-values widget :menu-history (nth x (motif-option-menu-buttons sheet)))
           (let* ((name (funcall name-key (nth x items)))
                  (pixmap (unless (or (null printer) (eq printer #'write-token))
                            (pixmap-from-menu-item
-                            (sheet-parent gadget) name printer nil)))
+                            (sheet-parent sheet) name printer nil
+			    :text-style (pane-text-style sheet)
+			    :background (pane-background sheet)
+			    :foreground (pane-foreground sheet))))
                  (widget (tk::intern-widget (tk::xm_option_button_gadget widget))))
             (if pixmap
                 (tk::set-values widget :label-pixmap pixmap :label-type :pixmap)
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index 601e09be34ed47056b1ff6350811ad6a139e2c7e..1c1a9cde62f0647682f8d9a702977159b80554b0 100644
--- a/tk-silica/xt-silica.lisp
+++ b/tk-silica/xt-silica.lisp
@@ -19,7 +19,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $fiHeader: xt-silica.lisp,v 1.102 1996/03/13 09:56:15 colin Exp $
+;; $fiHeader: xt-silica.lisp,v 1.103 1996/03/15 05:18:31 colin Exp $
 
 (in-package :xm-silica)
 
@@ -207,10 +207,11 @@
 	 (screen-pixels-per-inch
 	  (* 25.4 (/ (x11::xdisplayheight display screen)
 		     (x11:xdisplayheightmm display screen)))))
-    (labels ((parse-token (token)
-	       (and token
-		    (parse-integer token)))
-	     (font->text-style (font family)
+    (flet ((font->text-style (font family)
+	     (flet ((parse-token (token)
+		      (if token
+			  (parse-integer token)
+			(return-from font->text-style nil))))
 	       (let* ((tokens (disassemble-x-font-name font))
 		      (italic (member (nth 4 tokens) '("i" "o") :test #'equalp))
 		      (bold (equalp (nth 3 tokens) "bold"))
@@ -228,7 +229,7 @@
 			      (or (eql pixel-size 0)
 				  (eql point-size 0)
 				  (eql average-width 0)))
-		   (make-text-style family face (/ corrected-point-size 10))))))
+		   (make-text-style family face (/ corrected-point-size 10)))))))
       (dolist (per-charset *xt-font-families*)
 	(destructuring-bind (character-set fallback &rest families) per-charset
 	  (dolist (per-family families)
diff --git a/tk/graphics.lisp b/tk/graphics.lisp
index 7cf4a02d8f105c86518f51271bd58dd01b13feaf..ca7135aa29a4131feb7fa6ebc296f4d72aaf3fb4 100644
--- a/tk/graphics.lisp
+++ b/tk/graphics.lisp
@@ -19,7 +19,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $fiHeader: graphics.lisp,v 1.19 1996/01/23 06:46:58 duane Exp $
+;; $fiHeader: graphics.lisp,v 1.20 1996/03/01 05:43:25 colin Exp $
 
 (in-package :tk)
 
@@ -192,7 +192,7 @@
 
 (defun draw-image-string (drawable gc x y string
 			  &optional (length (length string)))
-  (x11::drawimagestring
+  (x11::xdrawimagestring
    (object-display drawable)
    drawable
    gc
diff --git a/tk/macros.lisp b/tk/macros.lisp
index 928ba4e89457f8f35a97830dad6a7691943cdb60..d007cb935369da89267c7e2806e3f4f1efbca927 100644
--- a/tk/macros.lisp
+++ b/tk/macros.lisp
@@ -19,7 +19,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $fiHeader: macros.lisp,v 1.17 1996/01/23 06:47:01 duane Exp $
+;; $fiHeader: macros.lisp,v 1.18 1996/03/01 05:43:27 colin Exp $
 
 (in-package :tk)
 
@@ -103,16 +103,22 @@
 	(:-ics ,string)))))
 
 (defmacro lisp-string-to-string16 (string)
-  (clim-utils:with-gensyms (length string16 i)
+  (clim-utils:with-gensyms (length string16 i j code)
     (clim-utils:once-only (string)
       `(excl:ics-target-case
 	(:+ics
 	 (let* ((,length (length ,string))
-		(,string16 (make-array (1+ ,length) :element-type '(unsigned-byte 16))))
+		(,string16 (make-array (* (1+ ,length) 2)
+				       :element-type '(unsigned-byte 8)))
+		(,j 0))
 	   (dotimes (,i ,length)
-	     (setf (aref ,string16 ,i)
-	       (xchar-code (char ,string ,i))))
-	   (setf (aref ,string16 ,length) 0)
+	     (let ((,code (xchar-code (char ,string ,i))))
+	       (setf (aref ,string16 ,j) (ldb (byte 8 8) ,code))
+	       (incf ,j)
+	       (setf (aref ,string16 ,j) (ldb (byte 8 0) ,code))
+	       (incf ,j)))
+	   (setf (aref ,string16 ,j) 0
+		 (aref ,string16 (1+ ,j)) 0)
 	   ,string16))
 	(:-ics (error "~S called in non-ICS Lisp"
 		      'lisp-string-to-string16))))))
diff --git a/tk/resources.lisp b/tk/resources.lisp
index 857cd20557fbbf368bd81b53990c5d52c2e2f75d..e3c3e191b937df333a735d0bab6292a65b53fb2b 100644
--- a/tk/resources.lisp
+++ b/tk/resources.lisp
@@ -19,7 +19,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $fiHeader: resources.lisp,v 1.55 1996/01/23 06:47:08 duane Exp $
+;; $fiHeader: resources.lisp,v 1.56 1996/03/01 05:43:35 colin Exp $
 
 
 (in-package :tk)
@@ -643,10 +643,6 @@
 	      (excl:euc-to-string euc)))
      (:-ics (char*-to-string value)))))
 
-(defmethod convert-resource-in ((parent t) (type (eql 'string)) value)
-  (unless (zerop value)
-))
-
 (defmethod convert-resource-in ((parent t) (type (eql 'boolean)) value)
   (not (zerop value)))
 
diff --git a/tk/xm-widgets.lisp b/tk/xm-widgets.lisp
index e5eaf4b1b55e17e7ddc3fb38e4cc3a0d1f907df3..38cacb6e1cf476231d723a397b318d13d6a2146f 100644
--- a/tk/xm-widgets.lisp
+++ b/tk/xm-widgets.lisp
@@ -19,7 +19,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $fiHeader: xm-widgets.lisp,v 1.23 1996/01/23 06:47:20 duane Exp $
+;; $fiHeader: xm-widgets.lisp,v 1.24 1996/03/01 05:43:49 colin Exp $
 
 (in-package :tk)
 
@@ -155,7 +155,7 @@
     (note-malloced-object
      (xm_string_create_l_to_r
       (note-malloced-object (string-to-char* value))
-      (note-malloced-object (string-to-char* xm-font-list-default-tag)))))))
+      (note-malloced-object (string-to-char* "")))))))
 
 (defmethod convert-resource-out ((parent t) (type (eql 'xm-background-pixmap)) value)
   (etypecase value
diff --git a/utils/excl-verification.lisp b/utils/excl-verification.lisp
index 8cb35586c323c6712a4f6a7580c3c93c9f933bd9..95e0b873d50bfe71797d9a328995a6168a40dfa1 100644
--- a/utils/excl-verification.lisp
+++ b/utils/excl-verification.lisp
@@ -19,7 +19,7 @@
 ;; Commercial Software developed at private expense as specified in
 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
 ;;
-;; $Header: /repo/cvs.copy/clim2/utils/excl-verification.lisp,v 1.20 1995/11/08 06:16:31 georgej Exp $
+;; $Header: /repo/cvs.copy/clim2/utils/excl-verification.lisp,v 1.21 1996/07/23 21:34:52 colin Exp $
 
 (in-package :sys)
 
@@ -34,31 +34,11 @@
   (pushnew :silica *features*)
   (pushnew :ansi-90 *features*))
 
-#-Silica
-(eval-when (compile load eval)
-  (require :clx))
-
 (provide :clim)
 (provide :climg)
 
-#+(not (version>= 4 1))
-(let* ((patch-package (find-package :patch))
-       (patches-symbol (and patch-package
-			    (find-symbol (string '*patches*) patch-package)))
-       (patches (and patches-symbol (symbol-value patches-symbol)))
-       (needed-patches '(26. 27. 46. 50.))
-       (dont-have (remove-if
-		   #'(lambda (pn)
-		       (assoc pn patches))
-		   needed-patches)))
-  (when dont-have
-    (error "On Allegro 4.0 CLIM requires patches ~{~S ~} ~
-You do not have patches ~{~S ~}"
-	   needed-patches
-	   dont-have)))
-
 (defvar *clim-version*
-    '("CLIM 2.1.beta"
-      "$Header: /repo/cvs.copy/clim2/utils/excl-verification.lisp,v 1.20 1995/11/08 06:16:31 georgej Exp $"))
+    '("CLIM 2.1"
+      "$Header: /repo/cvs.copy/clim2/utils/excl-verification.lisp,v 1.21 1996/07/23 21:34:52 colin Exp $"))
 
 (si::rcsnote (first *clim-version*) (second *clim-version*))
diff --git a/utils/packages.lisp b/utils/packages.lisp
index 678599e7f123781bed42b5faa1be3fc314632438..e11fa33f7592b23fc8c5e42c66bc4e6ceef53166 100644
--- a/utils/packages.lisp
+++ b/utils/packages.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: packages.lisp,v 1.68 1996/03/01 05:44:44 colin Exp $
+;; $fiHeader: packages.lisp,v 1.69 1996/03/13 09:56:23 colin Exp $
 
 (in-package :common-lisp-user)
 
@@ -2485,6 +2485,7 @@
     gadget-output-record
     gadget-range
     gadget-range*
+    gadget-spacing
     gadget-show-value-p
     gadget-value
     gadget-value-changed-callback
diff --git a/wnn/jserver.lisp b/wnn/jserver.lisp
index 2102bf4a3ecbb14a5015b7c115476276a7531303..fd81ece197748d08c9091da26f49f000cffd8a81 100644
--- a/wnn/jserver.lisp
+++ b/wnn/jserver.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: jserver.lisp,v 1.1 1995/10/20 17:42:17 colin Exp $
+;; $fiHeader: jserver.lisp,v 1.2 1996/03/01 05:44:50 colin Exp $
 
 (in-package :wnn)
 
@@ -61,9 +61,9 @@
 			 ;; it's important to specify a timeout of -1
 			 ;; in the call to jl_open_lang otherwise wnn
 			 ;; messes with sigalrm
-			 (jl_open_lang (tk::lisp-string-to-string8 login)
-				       (tk::lisp-string-to-string8 host)
-				       (tk::lisp-string-to-string8 lang)
+			 (jl_open_lang (ff:string-to-char* login)
+				       (ff:string-to-char* host)
+				       (ff:string-to-char* lang)
 				       0 0 0 -1))
 		(setf (mp:process-quantum mp:*current-process*) temp)
 		(mp:process-allow-schedule))))
diff --git a/wnn/load-wnn.lisp b/wnn/load-wnn.lisp
index 4491315b91003ab375eed2a59c385b18ca2d9b4d..ffea5f656803670083107c30c4f8e07eb0d3777f 100644
--- a/wnn/load-wnn.lisp
+++ b/wnn/load-wnn.lisp
@@ -18,12 +18,15 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: load-wnn.lisp,v 1.2 1996/03/13 09:56:55 colin Exp $
+;; $fiHeader: load-wnn.lisp,v 1.3 1996/03/15 05:18:37 colin Exp $
 
 (in-package :user)
 
 ;;; compare with tk/load-xm for update to new makefile style
 
+(excl:ics-target-case
+(:+ics
+
 #-dlfcn
 (progn
 
@@ -42,6 +45,6 @@
 (provide :wnn)
 (pushnew :wnn *features*)
 
-
+)) ;; ics-target-case