diff --git a/ChangeLog.n b/ChangeLog.n
index 808bada58346ae4ed28c3f87415b6e13c06039bd..cf5fba2ffddb5af3e5b878ebdb848a8728d6979d 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -1,3 +1,27 @@
+from cer: Mon Oct 25 09:13:49 PDT 1993
+
+Makefile.defs			Removed clim-motif_d.o from default build
+clim/accept-values.lisp		make-pane-from-view takes keywords to remove
+clim/command-processor.lisp	correct defaulting of translator :pointer-documentation
+clim/db-stream.lisp		Explicit max/min width/height overides :width/height :compute
+clim/gadget-output.lisp		make-pane-from-view takes keywords to remove
+				text-editor and list-pane views take :scroll-bars argument
+clim/graph-formatting.lisp	Implement :center-nodes t for tree layout
+clim/graphics-recording.lisp	Added with-half-thickness-1 for use in xt-graphics
+clim/menus.lisp			Removed bogus calling frame method
+				frame-manager-get-menu takes parent-frame argument
+clim/recording-protocol.lisp	Added COMMENTED OUT (setf stream-output-history) method
+clim/view-defs.lisp		make-pane-from-view takes keywords to remove
+climtoys/ibparts.lisp		Nothing serious
+demo/demo-driver.lisp		Added (*package* (find-package :clim-demo)) binding in demo-driver
+demo/plot.lisp			Removed bogus command
+misc/undefinedsymbols.xt	Added XtAppSetFallbackResources
+silica/db-scroll.lisp		Added x,y arguments to note-viewport-position-changed
+test/test-clim.lisp		Added test
+test/test-driver.lisp		If process does not terminate you now get an error.
+test/test-suite.lisp		Added centered node grapher test
+
+
 from cer: Wed Sep 22 14:19:31 PDT 1993
 
 Makefile.defs			-> devel.18
diff --git a/Makefile.defs b/Makefile.defs
index 143958c13f6ea43499e887d534d460002ff6303e..64c3f8830cd23f88433867df6b501219b8096b5d 100644
--- a/Makefile.defs
+++ b/Makefile.defs
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.defs,v 1.22 1993/09/22 18:26:12 layer Exp $
+# $fiHeader: Makefile.defs,v 1.23 1993/09/22 21:20:56 cer Exp $
 #
 #  Makefile.defs for CLIM 2.0
 #
@@ -141,7 +141,12 @@ OL_PUBLIC_OBJS= stub-olit.o olsupport.o
 
 PUBLIC_OBJS= $(GENERIC_PUBLIC_OBJS) $(XM_PUBLIC_OBJS) $(OL_PUBLIC_OBJS)
 OL_LICENSED_OBJS = clim-olit.o clim-olit_d.o
-XM_LICENSED_OBJS = clim-motif_d.o clim-motif.o 
+
+# mostly not used.
+#CLIMMOTIF_D= clim-motif_d.o
+CLIMMOTIF_D=
+
+XM_LICENSED_OBJS = $(CLIMMOTIF_D) clim-motif.o 
 
 MOTIF_OBJS= $(GENERIC_PUBLIC_OBJS) $(XM_PUBLIC_OBJS) $(XM_LICENSED_OBJS)
 OPENLOOK_OBJS= $(GENERIC_PUBLIC_OBJS) $(OL_PUBLIC_OBJS) $(OL_LICENSED_OBJS)
diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index 77030a42a49d1d2e409885a7018c2a60f99c9227..0b2997be3c6cda61f647730b8b88e2b275c7f27a 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.69 1993/09/17 19:04:56 cer Exp $
+;; $fiHeader: accept-values.lisp,v 1.70 1993/09/22 21:21:04 cer Exp $
 
 (in-package :clim-internals)
 
@@ -1577,7 +1577,7 @@
 						:resynchronize resynchronize)))
 		     (make-pane-from-view 
 		      'push-button
-		      view
+		      view ()
 		      :id record :client client
 		      :activate-callback #'(lambda (button)
 					     (when (accept-values-query-valid-p nil record) ;---can't be right
diff --git a/clim/command-processor.lisp b/clim/command-processor.lisp
index 643697ebce7255465ad84b8296dcdf94f94720ff..3aff1bbd1af2c78e74569abfd059bbe7c282d6b3 100644
--- a/clim/command-processor.lisp
+++ b/clim/command-processor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: command-processor.lisp,v 1.22 1993/07/27 01:38:27 colin Exp $
+;; $fiHeader: command-processor.lisp,v 1.23 1993/09/17 19:05:00 cer Exp $
 
 (in-package :clim-internals)
 
@@ -852,12 +852,16 @@
 	      :gesture ,gesture
 	      :tester ,tester
 	      :documentation ,documentation
+	      ;; Old behavior
 	      ;; The pointer documentation defaults to the name of the command,
 	      ;; not the documentation.  This is a speed bum.
-	      :pointer-documentation ,(or pointer-documentation
-					  (if (stringp documentation)
-					      documentation
-					      (command-name-from-symbol command-name)))
+	      ;; New Behavior is to to the right thing. If only
+	      ;; documentation is specified then rely on the
+	      ;; appropriate defaulting down the line to ensure that
+	      ;; we dont get duplicate functions.
+	      ,@(and (or pointer-documentation (null documentation))
+		     `(:pointer-documentation ,(or pointer-documentation
+						   (command-name-from-symbol command-name))))
 	      :menu ,menu
 	      :priority ,priority
 	      :tester-definitive t
diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp
index f6c2a8aae3e0cf78f4272acb33d60a680a698b23..367302c15ac118af37ff88bd5805107321d82eb0 100644
--- a/clim/db-stream.lisp
+++ b/clim/db-stream.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-stream.lisp,v 1.56 1993/07/27 01:38:51 colin Exp $
+;; $fiHeader: db-stream.lisp,v 1.57 1993/08/12 16:02:59 cer Exp $
 
 (in-package :clim-internals)
 
@@ -177,95 +177,115 @@
        ,@body)))
 
 (defmethod compose-space ((pane clim-stream-pane) &key width height)
-  (let ((sr (call-next-method)))
-    (labels 
+  (compute-space-for-clim-stream-pane pane (call-next-method) width height))
+
+(defun compute-space-for-clim-stream-pane (pane sr width height)
+  (labels 
       ((process-compute-space-requirements ()
 	 (with-space-requirement (sr)
 	   (when (do-with-space-req-components or
-		     sr-component 
-		     (sr-width sr-min-width sr-max-width
-		      sr-height sr-min-height sr-max-height) 
+		   sr-component 
+		   (sr-width sr-min-width sr-max-width
+			     sr-height sr-min-height sr-max-height) 
 		   (eq sr-component :compute))
 	     (multiple-value-bind (width height)
 		 (let ((record
-			 (let ((history (stream-output-history pane)))
-			   (if (and history
-				    (> (output-record-count history :fastp t) 0))
-			       history
-			       (let ((*sizing-application-frame* t))
-				 (with-output-to-output-record (pane)
-				   (funcall 
-				     (if (slot-value pane 'incremental-redisplay-p)
-					 #'invoke-pane-redisplay-function 
-					 #'invoke-pane-display-function)
-				     (pane-frame pane) pane
-				     ;;--- Are all pane display functions prepared to
-				     ;;--- ignore these arguments?  I think not...
-				     :max-width width
-				     :max-height height)))))))
+			(let ((history (stream-output-history pane)))
+			  (if (and history
+				   (> (output-record-count history :fastp t) 0))
+			      history
+			    (let ((*sizing-application-frame* t))
+			      (with-output-to-output-record (pane)
+				(funcall 
+				 (if (slot-value pane 'incremental-redisplay-p)
+				     #'invoke-pane-redisplay-function 
+				   #'invoke-pane-display-function)
+				 (pane-frame pane) pane
+				 ;;--- Are all pane display functions prepared to
+				 ;;--- ignore these arguments?  I think not...
+				 :max-width width
+				 :max-height height)))))))
 		   (with-bounding-rectangle* (left top right bottom) record
 		     (values (- right (min 0 left))
 			     (- bottom (min 0 top)))))
 	       (when (zerop width) (setq width 100))
 	       (when (zerop height) (setq height 100))
+
+	       (flet ((process-computes (size preferred min max)
+			(values
+			 (if (eq preferred :compute) 
+			     (let ((size size))
+			       (when (numberp min) (maxf size min))
+			       (when (numberp max) (minf size max))
+			       size)
+			   preferred) 
+			 (if (eq min :compute) size min)
+			 (if (eq max :compute) size max))))
+		 (multiple-value-setq (sr-width sr-min-width sr-max-width)
+		   (process-computes width sr-width sr-min-width sr-max-width))
+		 (multiple-value-setq (sr-height sr-min-height sr-max-height)
+		   (process-computes height sr-height sr-min-height sr-max-height)))
+	       
+	       #+ignore
 	       (do-with-space-req-components progn
-		   sr-component (sr-width sr-min-width sr-max-width)
+		 sr-component (sr-width sr-min-width sr-max-width)
 		 (when (eq sr-component :compute)
 		   (setq sr-component width)))
+	       #+ignore
 	       (do-with-space-req-components progn
-		   sr-component (sr-height sr-min-height sr-max-height)
+		 sr-component (sr-height sr-min-height sr-max-height)
 		 (when (eq sr-component :compute)
 		   (setq sr-component height))))
 	     (setq sr (make-sr)))))
-       (process-unit-space-requirements ()
-	 (with-space-requirement (sr)
-	   (let ((changed nil))
-	     (do-with-space-req-components progn
-		 sr-component 
-		 (sr-width sr-min-width sr-max-width
-		  sr-height sr-min-height sr-max-height) 
-	       (when (unit-space-requirement-p sr-component)
-		 (setq sr-component (process-unit-space-requirement pane sr-component)
-		       changed t)))
-	     (when changed
-	       (setq sr (make-sr))))))
-       (process-relative-space-requirements ()
-	 (with-space-requirement (sr)
-	   (unless (and (numberp sr-width)
-			(numberp sr-height)
-			(do-with-space-req-components and
-			    sr-component 
-			    (sr-min-width sr-max-width
-			     sr-min-height sr-max-height) 
-			  (or (numberp sr-component)
-			      (relative-space-requirement-p sr-component))))
-	     (error "Illegal space requirement ~S" sr))
-	   (let ((changed nil))
-	     (when (relative-space-requirement-p sr-min-width)
-	       (setq sr-min-width (- sr-width (process-unit-space-requirement
+	  (process-unit-space-requirements ()
+	    (with-space-requirement (sr)
+	      (let ((changed nil))
+		(do-with-space-req-components progn
+		  sr-component 
+		  (sr-width sr-min-width sr-max-width
+			    sr-height sr-min-height sr-max-height) 
+		  (when (unit-space-requirement-p sr-component)
+		    (setq sr-component (process-unit-space-requirement pane sr-component)
+			  changed t)))
+		(when changed
+		  (setq sr (make-sr))))))
+	(process-relative-space-requirements ()
+	  (with-space-requirement (sr)
+	    (unless (and (numberp sr-width)
+			 (numberp sr-height)
+			 (do-with-space-req-components and
+			   sr-component 
+			   (sr-min-width sr-max-width
+					 sr-min-height sr-max-height) 
+			   (or (numberp sr-component)
+			       (relative-space-requirement-p sr-component))))
+	      (error "Illegal space requirement ~S" sr))
+	    (let ((changed nil))
+	      (when (relative-space-requirement-p sr-min-width)
+		(setq sr-min-width (- sr-width (process-unit-space-requirement
 						pane (car sr-min-width)))
-		     changed t))
-	     (when (relative-space-requirement-p sr-max-width)
-	       (setq sr-max-width (+ sr-width (process-unit-space-requirement
+		      changed t))
+	      (when (relative-space-requirement-p sr-max-width)
+		(setq sr-max-width (+ sr-width (process-unit-space-requirement
 						pane (car sr-max-width)))
-		     changed t))
-	     (when (relative-space-requirement-p sr-min-height)
-	       (setq sr-min-height (- sr-height (process-unit-space-requirement
+		      changed t))
+	      (when (relative-space-requirement-p sr-min-height)
+		(setq sr-min-height (- sr-height (process-unit-space-requirement
 						  pane (car sr-min-height)))
-		     changed t))
-	     (when (relative-space-requirement-p sr-max-height)
-	       (setq sr-max-height (+ sr-height (process-unit-space-requirement
+		      changed t))
+	      (when (relative-space-requirement-p sr-max-height)
+		(setq sr-max-height (+ sr-height (process-unit-space-requirement
 						  pane (car sr-max-height)))
-		     changed t))
-	     (when changed
-	       (setq sr (make-sr)))))))
-      (declare (dynamic-extent #'process-compute-space-requirements
-			       #'process-unit-space-requirements
-			       #'process-relative-space-requirements))
-      (process-compute-space-requirements)
-      (process-unit-space-requirements)
-      (process-relative-space-requirements)
-      sr)))
+		      changed t))
+	      (when changed
+		(setq sr (make-sr)))))))
+    (declare (dynamic-extent #'process-compute-space-requirements
+			     #'process-unit-space-requirements
+			     #'process-relative-space-requirements))
+    (process-unit-space-requirements)
+    (process-compute-space-requirements)
+    (process-relative-space-requirements)
+    sr))
 
 (defun relative-space-requirement-p (sr)
   (and (consp sr)
diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp
index 0b0ecbdd9fba4c3d362113d1629f6590813a06cb..0b1b8ad330595d34f6596e18f94d1766779f83d0 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.52 1993/07/27 01:39:32 colin Exp $
+;; $fiHeader: gadget-output.lisp,v 1.53 1993/09/07 21:45:50 colin Exp $
 
 (in-package :clim-internals)
 
@@ -484,7 +484,7 @@
 	       (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
+      (let ((button (make-pane-from-view 'toggle-button view ()
 		      :label (and (stringp prompt) prompt)
 		      :value default
 		      :client stream :id query-identifier
@@ -537,7 +537,7 @@
       (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
+		(make-pane-from-view 'slider view ()
 		  :label (and (stringp prompt) prompt)
 		  :value (if default-supplied-p default min-value)
 		  :min-value min-value :max-value max-value
@@ -589,7 +589,7 @@
       (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
+		(make-pane-from-view 'slider view ()
 		  :label (and (stringp prompt) prompt)
 		  :value (if default-supplied-p default min-value)
 		  :min-value min-value :max-value max-value
@@ -631,7 +631,7 @@
 		        (object (type ,type) stream (view ,view) 
 			 &key acceptably query-identifier prompt)
 		      (declare (ignore acceptably))
-		      (,function stream view t object t type prompt query-identifier nil)))
+		      (,function stream view t object t type prompt query-identifier :editable-p nil)))
 	       types)))
 
 ;;--- Should there be a method specialized on T???
@@ -647,12 +647,12 @@
 			     &key (prompt t) (active-p t))
   (declare (ignore present-p))
   (make-gadget-for-text-field-view 
-    stream view active-p default default-supplied-p type prompt query-identifier t)) 
+    stream view active-p default default-supplied-p type prompt query-identifier :editable-p t)) 
 
 (defun make-gadget-for-text-field-view (stream view active-p default
 					default-supplied-p type
 					prompt query-identifier
-					&optional (editable-p t))
+					&key (editable-p t))
   (move-cursor-to-view-position stream view)
   (flet ((update-gadget (record gadget text-field)
  	   (declare (ignore record gadget))	     ;;-- This sucks
@@ -665,7 +665,7 @@
 	       ""))))
     (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
       (let ((text-field (make-pane-from-view 
-			  'text-field view
+			  'text-field view ()
 			  :label (and (stringp prompt) prompt)
 			  :value (if default-supplied-p
 				     (present-to-string default type)
@@ -724,7 +724,7 @@
 			     &key (prompt t) (active-p t))
   (declare (ignore default-supplied-p present-p))
   (make-gadget-for-text-editor
-    stream view active-p default t type prompt query-identifier t))
+    stream view active-p default t type prompt query-identifier :editable-p t))
 
 (define-present-methods-for-types 
     (make-gadget-for-text-editor text-editor-view)
@@ -733,8 +733,7 @@
 (defun make-gadget-for-text-editor (stream view active-p default
 				    default-supplied-p type
 				    prompt query-identifier
-				    &optional (editable-p t))
-
+				    &key (editable-p t))
   (move-cursor-to-view-position stream view)
   (flet ((update-gadget (record gadget button)
  	   (declare (ignore record gadget))
@@ -746,7 +745,7 @@
 		 default
 	       ""))))
     (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
-      (let ((text-field (make-pane-from-view 'text-editor view
+      (let ((text-field (make-pane-from-view 'text-editor view '(:scroll-bars)
 			  :label (and (stringp prompt) prompt)
 			  :value (if default-supplied-p
 				     default
@@ -765,7 +764,9 @@
 				    ,stream ,query-identifier))
 			    :active active-p
 			    :help-callback (make-gadget-help type))))
- 	(values (scrolling () text-field) text-field)))))
+ 	(values (scrolling (:scroll-bars (getf (view-gadget-initargs view) :scroll-bars :both)) 
+		  text-field) 
+		text-field)))))
 
 
 ;;; List and option panes
@@ -803,7 +804,7 @@
 	   list-pane))
     (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
       (let* ((pane (if (eq pane-type 'option-pane)
-		       (make-pane-from-view pane-type view
+		       (make-pane-from-view pane-type view ()
 			 :items sequence
 			 :name-key name-key
 			 :value-key value-key
@@ -818,7 +819,7 @@
 			    stream query-identifier)
 			 :active active-p
 			 :help-callback (make-gadget-help type))
-		       (make-pane-from-view pane-type view
+		       (make-pane-from-view pane-type view '(:scroll-bars)
 			 :items sequence
 			 :name-key name-key
 			 :value-key value-key
@@ -832,7 +833,9 @@
 			     stream query-identifier)
 			 :active active-p
 			 :help-callback (make-gadget-help type)))))
-	(values (if (eq pane-type 'list-pane) (scrolling () pane) pane)
+	(values (if (eq pane-type 'list-pane) 
+		    (scrolling (:scroll-bars (getf (view-gadget-initargs view) :scroll-bars :dynamic)) pane)
+		  pane)
 		pane)))))
 
 (define-presentation-method accept-present-default 
diff --git a/clim/graph-formatting.lisp b/clim/graph-formatting.lisp
index a2067dc09fcad9918008459360eb1d131d9596cb..bc07daccae1cf3493874f65769b45142a8ca4ee1 100644
--- a/clim/graph-formatting.lisp
+++ b/clim/graph-formatting.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graph-formatting.lisp,v 1.31 1993/07/22 15:37:56 cer Exp $
+;; $fiHeader: graph-formatting.lisp,v 1.32 1993/09/17 19:05:10 cer Exp $
 
 (in-package :clim-internals)
 
@@ -364,6 +364,7 @@
 	   (orientation (getf properties :orientation))
 	   (generation-separation (getf properties :generation-separation))
 	   (within-generation-separation (getf properties :within-generation-separation))
+	   (center-nodes (getf properties :center-nodes))
 	   (start-x (coordinate 0))
 	   (start-y (coordinate 0)))
       (dolist (root-node root-nodes)
@@ -395,11 +396,15 @@
 		       (my-breadth
 			 (+ ,breadth-var
 			    (round (max 0 (- total-child-breadth node-breadth)) 2))))
-		  (setf (node-depth-start ,node-var) ,depth-var
+		  (setf (node-depth-start ,node-var) (if center-nodes 
+							 (+ ,depth-var
+							    (round (- ,tallest-sibling-var (node-depth ,node-var))
+								   2))
+						       ,depth-var)
 			(node-breadth-start ,node-var) my-breadth)
 		  ;; Returns the breadth of the graph as a result
 		  (max total-child-breadth (node-breadth ,node-var))))))
-	  (ecase orientation
+ 	  (ecase orientation
 	    ((:vertical :down)
 	     (macrolet ((node-breadth (node) `(bounding-rectangle-width ,node))
 			(node-depth (node) `(bounding-rectangle-height ,node))
diff --git a/clim/graphics-recording.lisp b/clim/graphics-recording.lisp
index 3876e5fdb0a43d571ff8a7c8b64ef6a3c52c74cf..322b101ba388e4ed24c1e2f3bf9925471abf9ffb 100644
--- a/clim/graphics-recording.lisp
+++ b/clim/graphics-recording.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graphics-recording.lisp,v 1.23 1993/07/27 01:39:42 colin Exp $
+;; $fiHeader: graphics-recording.lisp,v 1.24 1993/09/07 21:45:57 colin Exp $
 
 (in-package :clim-internals)
 
@@ -199,18 +199,21 @@
 		       ,@body))))))))))
 
 (defmacro with-half-thickness ((lthickness rthickness) line-style &body body)
-  (let ((ls '#:line-style)
-	(thickness '#:thickness))
-    `(let* ((,ls ,line-style)
-	    (,thickness  (if ,ls (line-style-thickness ,ls) 0))
-	    (,lthickness (floor ,thickness 2))
-	    (,rthickness (- ,thickness ,lthickness)))
-       ,@body)))
+  (let ((ls '#:line-style))
+    `(let* ((,ls ,line-style))
+       (with-half-thickness-1 (,lthickness ,rthickness) (if ,ls (line-style-thickness ,ls) 0)
+	 ,@body))))
 
+(defmacro with-half-thickness-1 ((lthickness rthickness) thickness &body body)
+  (let ((thicky '#:thicky))
+    `(let* ((,thicky ,thickness)
+	    (,lthickness (floor ,thicky 2))
+	    (,rthickness (- ,thicky ,lthickness)))
+       ,@body)))
 
 (define-graphics-recording draw-point (ink line-style clipping-region)
   :bounding-rectangle 
-    (with-half-thickness (lthickness rthickness) line-style
+  (with-half-thickness (lthickness rthickness) line-style
       (values (- x lthickness)
 	      (- y lthickness)
 	      (+ x rthickness)
diff --git a/clim/menus.lisp b/clim/menus.lisp
index 96dd751267a7606cbf9cf342f188234e735e1ac5..e9a9cd049587eb77c47093ededbfdac4f27416af 100644
--- a/clim/menus.lisp
+++ b/clim/menus.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: menus.lisp,v 1.44 1993/05/05 01:38:44 cer Exp $
+;; $fiHeader: menus.lisp,v 1.45 1993/05/25 20:40:58 cer Exp $
 
 (in-package :clim-internals)
 
@@ -37,13 +37,16 @@
 	   main)))))
   (:menu-bar nil))
 
-(defmethod frame-calling-frame ((frame menu-frame))
-  ;; This is funny
-  (and (boundp '*application-frame*)
-       *application-frame*))
+;(defmethod frame-calling-frame ((frame menu-frame))
+;  ;; This is funny
+;  ;; I suppose we are doing this because really the frame should have
+;  ;; the correct parent and there is no otherway of doing this
+;  (and (boundp '*application-frame*)
+;       *application-frame*))
 
 ;; Returns a stream that corresponds to the pane holding the menu
-(defmethod frame-manager-get-menu ((framem standard-frame-manager) &key scroll-bars label)
+(defmethod frame-manager-get-menu ((framem standard-frame-manager) &key scroll-bars label parent-frame)
+  (declare (ignore parent-frame))
   (let ((frame (make-application-frame 'menu-frame
 				       :label label
 				       :scroll-bars scroll-bars
@@ -57,7 +60,10 @@
 (defresource menu (associated-window root &key label (scroll-bars t))
 	     :constructor 
 	     (let* ((framem (if (null root) (find-frame-manager) (frame-manager root))))
-	       (frame-manager-get-menu framem :scroll-bars scroll-bars :label label))
+	       (frame-manager-get-menu framem 
+				       :scroll-bars scroll-bars
+				       :label label
+				       :parent-frame (pane-frame root)))
 	     :matcher (and (eq scroll-bars (menu-frame-scroll-bars (pane-frame menu)))
 			   (eq (not label) (not (menu-frame-label (pane-frame menu))))
 			   (eq (frame-manager menu) (frame-manager root)))
diff --git a/clim/recording-protocol.lisp b/clim/recording-protocol.lisp
index a437ce89896840d73f6fe60d108cd500036024a8..244e90a0d1da7247a550c26f97b20b8e38cbb16c 100644
--- a/clim/recording-protocol.lisp
+++ b/clim/recording-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: recording-protocol.lisp,v 1.35 1993/07/27 01:40:59 colin Exp $
+;; $fiHeader: recording-protocol.lisp,v 1.36 1993/09/17 19:05:23 cer Exp $
 
 (in-package :clim-internals)
 
@@ -1119,6 +1119,22 @@
     (when (typep output-record 'stream-output-history-mixin)
       (setf (slot-value output-record 'stream) stream))))
 
+
+;(defmethod (setf stream-output-history) ((history stream-output-history-mixin)
+;					 (stream output-recording-mixin))
+;  (let ((old (stream-output-history stream)))
+;    (when old (note-output-record-detached old)))
+;  (call-next-method)
+;  ;;--- Our OUTPUT-RECORDING-MIXIN expects extended output...
+;  (multiple-value-bind (x y) (stream-cursor-position stream)
+;    ;; I don't understand why the output record's initial position was set to
+;    ;; some untransformed "viewport" coordinate.  The cursor position is the
+;    ;; right place, no?
+;    (output-record-set-position history x y))
+;  ;;
+;  (setf (slot-value history 'stream) stream)
+;  history)
+
 (defmethod clear-output-history ((stream output-recording-mixin))
   (when (stream-output-history stream)
     (clear-output-record (stream-output-history stream)))
diff --git a/clim/view-defs.lisp b/clim/view-defs.lisp
index 5fe69fc917d1fbfca0441f106ce057da4ed861f2..cc649682aa5582102d910990df985c39b7267839 100644
--- a/clim/view-defs.lisp
+++ b/clim/view-defs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: view-defs.lisp,v 1.13 1993/05/25 20:41:07 cer Exp $
+;; $fiHeader: view-defs.lisp,v 1.14 1993/09/17 19:05:29 cer Exp $
 
 (in-package :clim-internals)
 
@@ -92,6 +92,7 @@
   (getf (view-gadget-initargs view) :decimal-places))
 
 
-(defmacro make-pane-from-view (class view &body initargs)
-  `(apply #'make-pane ,class (append (view-gadget-initargs ,view) (list ,@initargs))))
+(defmacro make-pane-from-view (class view ignore &body initargs)
+  `(apply #'make-pane ,class (append (remove-keywords (view-gadget-initargs ,view) ,ignore)
+				     (list ,@initargs))))
 
diff --git a/demo/demo-driver.lisp b/demo/demo-driver.lisp
index 079d0e8fcd9e97b43cbc171cf878c511ff4a0560..7c8e1e06c20a87d51ce836170dacb039aee711c2 100644
--- a/demo/demo-driver.lisp
+++ b/demo/demo-driver.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: demo-driver.lisp,v 1.26 1993/09/17 18:35:47 colin Exp $
+;; $fiHeader: demo-driver.lisp,v 1.27 1993/09/22 21:21:15 cer Exp $
 
 (in-package :clim-demo)
 
@@ -66,7 +66,8 @@
 (defun run-demo (demo &key (port (find-port)) force)
   (let* ((entry (assoc port (demo-frames demo)))
 	 (frame (cdr entry))
-	 (activity-p (subtypep (demo-class demo) 'activity)))
+	 (activity-p (subtypep (demo-class demo) 'activity))
+	 (*package* (find-package :clim-demo)))
     (when (or force (null frame))
       (setq frame (apply (if activity-p
 			     #'make-instance
diff --git a/demo/plot.lisp b/demo/plot.lisp
index de1e560c49165a8814fee6f32ea790f5df1af4c1..32d35e9fb55e272e152a108a8dab16e4da657d42 100644
--- a/demo/plot.lisp
+++ b/demo/plot.lisp
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
-;; $fiHeader: plot.lisp,v 1.29 1993/09/17 19:05:59 cer Exp $
+;; $fiHeader: plot.lisp,v 1.30 1993/09/22 21:21:17 cer Exp $
 
 (in-package :clim-demo)
 
@@ -790,9 +790,3 @@
 
 
 (define-demo "Plotting Demo" plot-demo)
-
-(define-plot-demo-command com-zoom-graph-point
-    ((point 'graph-point))
-  (describe point))
-
-
diff --git a/misc/undefinedsymbols.motif b/misc/undefinedsymbols.motif
index 7323b205fbc22f19b5b9567e2a338a12e35a0559..3b22ca45f77b9b37463b4e4cc2019d502aa2ca24 100644
--- a/misc/undefinedsymbols.motif
+++ b/misc/undefinedsymbols.motif
@@ -6,6 +6,9 @@ XmFontListInitFontContext
 XmFontListFreeFontContext
 XmFontListGetNextFont
 XmFontListCreate
+XmFontListEntryCreate
+XmFontListAppendEntry
+XmFontListEntryGetFont
 XmAddProtocolCallback
 XmInternAtom
 XmIsTraversable
diff --git a/misc/undefinedsymbols.xt b/misc/undefinedsymbols.xt
index 3374cd8cdd5835a16a19160e76e4332a904439c0..06297f0372e7b2490bb0251d5029ae2ceeda9c17 100644
--- a/misc/undefinedsymbols.xt
+++ b/misc/undefinedsymbols.xt
@@ -41,3 +41,4 @@ XtUnmanageChildren
 XtWindow
 XtParseTranslationTable
 XtParseAcceleratorTable
+XtAppSetFallbackResources
diff --git a/silica/db-scroll.lisp b/silica/db-scroll.lisp
index ac1874de3ef9f526e1ff36fc3aaa695188a977e6..2a96771288d9383d9949658c813e51898abc2f10 100644
--- a/silica/db-scroll.lisp
+++ b/silica/db-scroll.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-scroll.lisp,v 1.47 1993/06/04 16:06:35 cer Exp $
+;; $fiHeader: db-scroll.lisp,v 1.48 1993/08/12 16:04:10 cer Exp $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright(c) 1991, 1992 International Lisp Associates.
@@ -259,10 +259,10 @@
 		  (repaint-sheet sheet region)))))
 	  (let ((frame (pane-frame sheet)))
 	    (when (and (/= left x) (/= top y) frame)
-	      (note-viewport-position-changed frame sheet))))))))
+	      (note-viewport-position-changed frame sheet x y))))))))
 
-(defmethod note-viewport-position-changed (frame pane)
-  (declare (ignore frame pane))
+(defmethod note-viewport-position-changed (frame pane x y)
+  (declare (ignore frame pane x y))
   nil)
 
 ;;; Given min1, max1 and value1 which is between them it will return
diff --git a/test/test-clim-tests.lisp b/test/test-clim-tests.lisp
index 288969ad2ca717cfa01c0890a56ecbdbdda7a343..16483062329f575204c0a0f43e62e2bc8c16846d 100644
--- a/test/test-clim-tests.lisp
+++ b/test/test-clim-tests.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: test-clim-tests.lisp,v 1.1 1993/08/12 16:04:23 cer Exp $
+;; $fiHeader: test-clim-tests.lisp,v 1.2 1993/09/17 19:06:22 cer Exp $
 
 
 (in-package :clim-user)
@@ -105,7 +105,12 @@
   :abort
   )
 
+(define-frame-test more-simple-menu-test (clim-tests 
+				    :width 600 :height 600)
+  ((com-more-simple-menus))
+  (exit-clim-tests))
 
+  
 (define-frame-test more-clim-tests (clim-tests 
 				    :width 600 :height 600)
   ((com-read-image-test)
@@ -126,7 +131,7 @@
   (com-text-formatting)
 
   (com-negative-extent)
-  (com-more-simple-menus)
+  
   (com-readonly-gadget-dialog)
   :abort
   (com-ozone-dialog)
diff --git a/test/test-clim.lisp b/test/test-clim.lisp
index 52f20fb01789474b4ddd23d259c7f3dd2f40cbe9..79a3997b904e3b15921ac0f6d0f0aeebe8ef8b38 100644
--- a/test/test-clim.lisp
+++ b/test/test-clim.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: test-clim.lisp,v 1.12 1993/08/12 16:04:25 cer Exp $
+;; $fiHeader: test-clim.lisp,v 1.13 1993/09/17 19:06:24 cer Exp $
 
 
 (in-package :clim-user)
@@ -451,3 +451,8 @@
     (handler-case (accept-from-string '(subset :a :b) "a,c")
       (error (c) c)
       (:no-error (&rest ignore) ignore (error "subset bogus failed")))))
+
+
+(define-frame-test test-avv-text-fields-and-list-panes-with-scroll-bars (tf115)
+  ()
+  (com-quit))
diff --git a/test/test-driver.lisp b/test/test-driver.lisp
index fac7169be80e86845bbcb36c982c1f0f5c4efe9c..dcd88e7e64249cd746f17e262c3f395d425a38df 100644
--- a/test/test-driver.lisp
+++ b/test/test-driver.lisp
@@ -58,6 +58,7 @@
 (defmethod destroy-invocation ((inv activity-invocation))
   (destroy-activity (invocation-activity inv)))
 
+
 (defun initialize-invocation (inv frame &optional process)
   (labels ((do-it (frame)
 	     (unwind-protect
@@ -126,7 +127,7 @@
     (unless (mp::process-stack-group process) (error "Frame terminated abnormally"))
     (execute-one-command invocation exit-command)
     (unless (wait-for-death process)
-      (warn "Process did not terminate"))))
+      (error "Process did not terminate"))))
 
 (defun wait-for-death (process)
   (let (done)
@@ -270,10 +271,11 @@
 			(execute-commands-in-invocation 
 			 invocation command-continuation))
 		       (function (funcall command-continuation)))
-		 (terminate-invocation invocation exit-command)
-		 (mp::process-kill (invocation-process invocation))
-		 (unless (wait-for-death (invocation-process invocation))
-		   (warn "Process would not die when killed"))
+		 (unwind-protect
+		     (terminate-invocation invocation exit-command)
+		   (mp::process-kill (invocation-process invocation))
+		   (unless (wait-for-death (invocation-process invocation))
+		     (warn "Process would not die when killed")))
 		 (destroy-invocation invocation))))))
     (if error
 	(with-test-success-expected (test-name)
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 275da5892264fe951dbf8f6619623d99e2e14178..3c5d60fbc4230a40fff40bfe15f641ced5062246 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.71 1993/09/17 00:21:17 colin Exp $
+;; $fiHeader: test-suite.lisp,v 1.72 1993/09/17 19:06:31 cer Exp $
 
 (in-package :clim-user)
 
@@ -1400,12 +1400,6 @@ people, shall not perish from the earth.
      (mapcar #'find-class '(clos:metaobject clos::dependee-mixin))
      #'(lambda (o s)
 	 (let ((text (format nil "~A" (clos::class-name o))))
-	   #+ignore
-	   (with-output-as-gadget (s)
-	     (make-pane 'push-button :label text
-			:activate-callback #'(lambda (gadget) (print
-							       text excl:*initial-terminal-io*))))
-	   #-ignore
 	   (multiple-value-bind (width height) (text-size s text)
 	     (with-new-output-record (s)
 	       (draw-rectangle* s 0 0 width height :filled t :ink color)
@@ -1414,6 +1408,29 @@ people, shall not perish from the earth.
      :stream stream
      :merge-duplicates t)))
 
+(define-test (simple-node-centered-graphs formatted-output) (stream)
+  "Two graphs, one with nodes centered"
+  (let ((color (make-gray-color 0.7)))
+    (with-text-size (stream :tiny)
+      (formatting-item-list (stream)
+	(dolist (center-nodes '(nil t))
+	  (formatting-cell (stream)
+	    (format-graph-from-roots 
+	     ;; dependee-mixin no longer exported -- smh 18may93
+	     (mapcar #'find-class '(number))
+	     #'(lambda (o s)
+		 (let ((text (format nil "~A" (clos::class-name o))))
+		   (multiple-value-bind (width height) (text-size s text)
+		     (with-new-output-record (s)
+		       (draw-rectangle* s 0 0 width height :filled t :ink color)
+		       (draw-text* s text 0 0 :align-x :left :align-y :top))))) 
+	     #'clos::class-direct-subclasses
+	     :stream stream
+	     :center-nodes center-nodes
+	     :merge-duplicates nil)))))))
+
+
+
 (define-test (offset-graph formatted-output) (stream)
   "Draw a graph offset in the window.  After refreshing, it should look the same."
   (let ((orientation :horizontal))
diff --git a/test/test.lisp b/test/test.lisp
index 349dc8c09e3acbda289aa4c3184b3131a4a60281..f3f75848ba22d252cca05da13934152422c204b9 100644
--- a/test/test.lisp
+++ b/test/test.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: test.lisp,v 1.51 1993/08/12 16:04:35 cer Exp $
+;; $fiHeader: test.lisp,v 1.52 1993/09/07 21:46:57 colin Exp $
 
 (in-package :clim-user)
 
@@ -1186,3 +1186,30 @@
       (setf (gadget-value cb) n2)
       (assert (equal n2 (check-box-current-selection cb))))))
 
+
+(define-application-frame tf115 ()
+  ()
+  (:menu-bar nil)
+  (:command-table test-frame)
+  (:panes
+   (a :accept-values
+      :display-function '(accept-values-pane-displayer :displayer display-tf115)
+      :width :compute
+      :height :compute))
+  (:layouts
+   (default a)))
+
+(defun display-tf115 (frame stream &key &allow-other-keys)
+  (formatting-table (stream)
+    (dolist (view '(list-pane-view text-editor-view))
+      (formatting-row (stream)
+	(dolist (scroll-bars '(nil :both :vertical :horizontal))
+	  (formatting-cell (stream)
+	    (accept (ecase view
+		      (list-pane-view '(member a b c d e f))
+		      (text-editor-view 'string))
+		    :stream stream
+		    :prompt nil
+		    :query-identifier (cons view scroll-bars)
+		    :view (cons view (and scroll-bars `(:scroll-bars ,scroll-bars))))))))))
+	
diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp
index b7af67856f18d531134f7ecbfe387489c73c0ed1..7a1c9d67b3a63a840ef2e4d83bee06c8bf9c644c 100644
--- a/tk-silica/ol-gadgets.lisp
+++ b/tk-silica/ol-gadgets.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-gadgets.lisp,v 1.59 1993/08/12 16:05:03 cer Exp $
+;; $fiHeader: ol-gadgets.lisp,v 1.60 1993/09/17 19:07:01 cer Exp $
 
 
 (in-package :xm-silica)
@@ -1444,6 +1444,17 @@
       'openlook-frame-pane
     'openlook-scrolling-window))
 
+(defmethod make-pane-arglist ((framem openlook-frame-manager) 
+			      (class (eql 'scroller-pane)) 
+			      &rest options &key contents)
+  (declare (ignore type))
+  (declare (non-dynamic-extent options))
+  ;; This is annoying. Because we are making a different class we
+  ;; have to discard :scroll-bars
+  (if (gadget-includes-scrollbars-p contents)
+      (remove-keywords options '(:scroll-bars))
+    options))
+
 (defmethod gadget-includes-scrollbars-p ((pane t))
   nil)
 
diff --git a/tk-silica/xm-frames.lisp b/tk-silica/xm-frames.lisp
index d67fe4c654969a4af3a2f2869621fd4350aa9bd5..8245b929e60db489559a02e2e32d69cd313ff84d 100644
--- a/tk-silica/xm-frames.lisp
+++ b/tk-silica/xm-frames.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-frames.lisp,v 1.61 1993/07/27 01:55:21 colin Exp $
+;; $fiHeader: xm-frames.lisp,v 1.62 1993/09/17 19:07:07 cer Exp $
 
 (in-package :xm-silica)
 
@@ -568,7 +568,13 @@
 	  (ok-button cancel-button help-button separator)
 	  (get-message-box-child dialog :ok :cancel :help :separator)
 	(tk::unmanage-child help-button)
-	(xt::unmanage-child cancel-button)
+	;; 
+	(if (find-restart 'abort nil)
+	    (tk::add-callback cancel-button :activate-callback #'(lambda (widget count process)
+								   (declare (ignore widget count))
+								   (mp:process-interrupt process 'abort))
+			      mp:*current-process*)
+	  (xt::unmanage-child cancel-button))
 	(tk::unmanage-child ok-button)
 	(tk::unmanage-child separator))
       (let ((slider
@@ -622,12 +628,14 @@
 
 (defmethod clim-internals::frame-manager-get-menu ((framem
 						    motif-frame-manager) &key scroll-bars
-						    label)
+									      label
+									      parent-frame)
   (let ((frame (make-application-frame 'motif-menu-frame
 				       :scroll-bars scroll-bars
 				       :label label
 				       :frame-manager framem
-				       :save-under t)))
+				       :save-under t
+				       :calling-frame parent-frame)))
     ;; This so that ports can do something interesting with popped-up
     ;; menu frames, such as implemented "click off menu to abort".
     (setf (getf (frame-properties frame) :menu-frame) t)
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index 4dbb7d95e624b8cd3d3ebcfa8fe69418d0c25481..8df4c59d3008e571d10b9315a3315cae0d80becd 100644
--- a/tk-silica/xm-gadgets.lisp
+++ b/tk-silica/xm-gadgets.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-gadgets.lisp,v 1.81 1993/09/07 21:47:09 colin Exp $
+;; $fiHeader: xm-gadgets.lisp,v 1.82 1993/09/17 19:07:10 cer Exp $
 
 (in-package :xm-silica)
 
@@ -688,7 +688,7 @@
 		  (silica::scroller-pane-scroll-bar-policy p)))))
       (values 'tk::xm-text
 	      (append
-	       `(:scroll-horizontal ,(and (member scroll-mode '(t :both :horizonal :dynamic)) t))
+	       `(:scroll-horizontal ,(and (member scroll-mode '(t :both :horizontal :dynamic)) t))
 	       `(:scroll-vertical ,(and (member scroll-mode '(t :both :vertical :dynamic)) t))
 	       (and (not editable) '(:cursor-position-visible nil))
 	       (list :edit-mode :multi-line)
diff --git a/tk-silica/xt-frames.lisp b/tk-silica/xt-frames.lisp
index 84f85d5250341414c695d03ab165d51604126f98..b256889269effa8bd9e90f2518a0a64b3b8a3eb9 100644
--- a/tk-silica/xt-frames.lisp
+++ b/tk-silica/xt-frames.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-frames.lisp,v 1.40 1993/09/17 00:21:27 colin Exp $
+;; $fiHeader: xt-frames.lisp,v 1.41 1993/09/17 19:07:17 cer Exp $
 
 
 (in-package :xm-silica)
@@ -157,34 +157,35 @@
 			    (port-display port)))
       (declare (ignore ignore win1 win2 x y))
       (tk::set-values menu :x root-x :y root-y)
-
-      (catch 'menu-choose
-	(unwind-protect
-	    (progn
-	      (loop
-		(when (funcall closure) (return nil))
-
-
-		(framem-enable-menu framem menu)
-		;; Now we have to wait
-		(port-force-output port)
-		(with-toolkit-dialog-component (menu-choose items)
-		  (wait-for-callback-invocation
-		   port
-		   #'(lambda () 
-		       ;;-- This is to deal
-		       ;;-- with the race
-		       ;;-- condition where
-		       ;;-- the menu go down
-		       ;;-- to quick
-		       (or (funcall closure)
-			   (not (framem-menu-active-p framem menu)))) 
-		   "Returned value")))
-	      (framem-popdown-menu framem menu))
-	  (unless cache
-	    (framem-destroy-menu framem menu)))
-	(port-force-output port)
-	(values-list (nth-value 1 (funcall closure)))))))
+      (let ((aborted t))
+	(catch 'menu-choose
+	  (unwind-protect
+	      (progn
+		(loop
+		  (when (funcall closure) 
+		    (setq aborted nil)
+		    (return nil))
+		  (framem-enable-menu framem menu)
+		  ;; Now we have to wait
+		  (port-force-output port)
+		  (with-toolkit-dialog-component (menu-choose items)
+		    (wait-for-callback-invocation
+		     port
+		     #'(lambda () 
+			 ;;-- This is to deal
+			 ;;-- with the race
+			 ;;-- condition where
+			 ;;-- the menu go down
+			 ;;-- to quick
+			 (or (funcall closure)
+			     (not (framem-menu-active-p framem menu)))) 
+		     "Returned value")))
+		(framem-popdown-menu framem menu))
+	    (if cache
+		(when aborted (framem-popdown-menu framem menu))
+	      (framem-destroy-menu framem menu)))
+	  (port-force-output port)
+	  (values-list (nth-value 1 (funcall closure))))))))
 
 (defmethod frame-manager-allows-menu-caching ((framem xt-frame-manager))
   t)
diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp
index 5ab70319848f9d6cd3837025b471eee0c3659cd8..d70f2701ef6b6005ac415fe08ff63bd89e0df752 100644
--- a/tk-silica/xt-graphics.lisp
+++ b/tk-silica/xt-graphics.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-graphics.lisp,v 1.80 1993/09/17 19:07:19 cer Exp $
+;; $fiHeader: xt-graphics.lisp,v 1.81 1993/09/22 21:21:26 cer Exp $
 
 (in-package :tk-silica)
 
@@ -822,6 +822,11 @@
 	(< (the fixnum ,x) 32000) (> (the fixnum ,x) -32000)
 	(< (the fixnum ,y) 32000) (> (the fixnum ,y) -32000)))
 
+(defmacro single-float-valid-point-p (x y)
+  `(and (< (the single-float ,x) 32000s0) 
+	(> (the single-float ,x) -32000s0)
+	(< (the single-float ,y) 32000s0) 
+	(> (the single-float ,y) -32000s0)))
 ;;
 ;; Here we implement a simple version of the Cohen-Sutherland clipping
 ;; algorithm.  Specifically, we only try to clip the line so that it will
@@ -954,9 +959,61 @@
 	  then (return-from ,function-name)
 	  else (error "Coordinate(s) out of (signed-byte 16) range")))))
 
+
+(defmacro single-float-discard-illegal-coordinates (function-name &rest positions)
+  (assert (evenp (length positions)) (positions)
+    "There must be an even number of elements in ~S" positions)
+  (let ((forms nil))
+    (do ()
+	((null positions))
+      (let* ((x (pop positions))
+	     (y (pop positions)))
+	(push `(single-float-valid-point-p ,x ,y) forms)))
+    `(unless (and ,@forms)
+       (if* *discard-illegal-graphics*
+	  then (return-from ,function-name)
+	  else (error "Coordinate(s) out of (signed-byte 16) range")))))
 
  
+
+
+(defmacro with-single-floats (variable-bindings &body body)
+  (flet ((binding-var (x) (if (atom x) x (car x)))
+	 (binding-form (x) (if (atom x) x (second x))))
+    `(let ,(mapcar #'(lambda (x)
+		       `(,(binding-var x) (float ,(binding-form x) 0s0)))
+	    variable-bindings)
+       (declare (single-float ,@(mapcar #'binding-var variable-bindings)))
+       ,@body)))
+
+(defmacro with-fixnums (variable-bindings &body body)
+  (flet ((binding-var (x) (if (atom x) x (car x)))
+	 (binding-form (x) (if (atom x) x (second x))))
+    `(let ,(mapcar #'(lambda (x)
+		       `(,(binding-var x) (fix-coordinate ,(binding-form x))))
+	    variable-bindings)
+       (declare (fixnum ,@(mapcar #'binding-var variable-bindings)))
+       ,@body)))
+
+(defmacro with-mins-and-maxes (variables &body body)
+  `(let ,(mapcan #'(lambda (binding)
+		     (destructuring-bind (min-var max-var form1 form2) binding
+		       `((,min-var ,form1)
+			 (,max-var ,form2))))
+	  variables)
+     (declare (single-float ,@(mapcar #'first variables) ,@(mapcar #'second variables)))
+     #+ignore (print-variables min-x min-y max-x max-y)
+     ,@(mapcar #'(lambda (binding)
+		   (destructuring-bind (min-var max-var form1 form2) binding
+		     (declare (ignore form1 form2))
+		     `(when (> ,min-var ,max-var) 
+			(rotatef ,min-var ,max-var))))
+	       variables)
+     ,@body))
+
+
 (defmethod medium-draw-point* ((medium xt-medium) x y)
+  (declare (optimize (speed 3) (safety 0)))
   (let ((drawable (medium-drawable medium)))
     (when drawable
       (let* ((ink (medium-ink medium))
@@ -964,10 +1021,10 @@
 	     (thickness (line-style-thickness line-style))
 	     (sheet (medium-sheet medium))
 	     (transform (sheet-device-transformation sheet)))
-	;;--rounding
-	(convert-to-device-coordinates transform x y)
-	(discard-illegal-coordinates medium-draw-point* x y)
+	(transform-positions transform x y)
 	(cond ((< thickness 1.5)
+	       (fix-coordinates x y)
+	       (discard-illegal-coordinates medium-draw-point* x y)
 	       (tk::draw-point
 		drawable
 		(adjust-ink (decode-ink ink medium)
@@ -975,19 +1032,24 @@
 			    x y)
 		x y))
 	      (t
-	       (setq thickness (round thickness))
-	       (tk::draw-ellipse
-		drawable
-		(adjust-ink (decode-ink ink medium)
-			    medium
-			    (the fixnum (- (the fixnum x) (the fixnum thickness)))
-			    (the fixnum (- (the fixnum y) (the fixnum thickness))))
-		x y 
-		0
-		thickness 
-		0
-		thickness 0 2pi
-		t)))))))
+	       ;;--rounding
+	       ;;--what is the most efficient way of doing this?
+	       (with-single-floats (x y)
+		 (clim-internals::with-half-thickness-1 (lthickness rthickness) thickness
+		   (declare (ignore rthickness))
+		   (with-fixnums ((min-x (- x lthickness))
+				  (min-y (- y lthickness))
+				  (size thickness))
+		     (discard-illegal-coordinates medium-draw-point* min-x min-y)
+		     (tk::draw-ellipse-1
+		      drawable
+		      (adjust-ink (decode-ink ink medium)
+				  medium
+				  min-x
+				  min-y)
+		      min-x min-y 
+		      size size 0 #.(* 360 64)
+		      t))))))))))
 
 (defmethod medium-draw-points* ((medium xt-medium) position-seq)
   (let ((drawable (medium-drawable medium)))
@@ -1000,9 +1062,9 @@
 	(let* ((len (length position-seq))
 	       (xpoints (/ len 2))
 	       (j 0)
-	       (minx (ash 1 15))
-	       (miny (ash 1 15)))
-	  (declare (fixnum j xpoints minx miny))
+	       (minx #.(ash 1 15))
+	       (miny #.(ash 1 15)))
+	  (declare (fixnum len j xpoints minx miny))
 	  (macrolet ((inner-guts ()
 		       `(if (listp position-seq)
 			    (loop
@@ -1035,35 +1097,36 @@
 		      j
 		      x11:coordmodeorigin)))
 		  (t
-		   (setq thickness (round thickness))
-		   (let ((points (tk::make-xarc-array :number xpoints)))
-		     (macrolet ((guts (x y)
-				  `(let ((x ,x)
-					 (y ,y))
-				     (convert-to-device-coordinates transform x y)
-				     (when (valid-point-p x y)
-				       (minf minx x)
-				       (minf miny y)
-				       (setf (tk::xarc-array-x points j) x
-					     (tk::xarc-array-y points j) y
-					     (tk::xarc-array-width points j) thickness
-					     (tk::xarc-array-height points j) thickness
-					     (tk::xarc-array-angle1 points j) 0
-					     (tk::xarc-array-angle2 points j) (* 360 64))
-				       (incf j)))))
-		       (inner-guts))
-		     (x11::xfillarcs
-		      (tk::object-display drawable)
-		      drawable
-		      (adjust-ink (decode-ink ink medium)
-				  medium
-				  ;;--rounding
-				  ;;-- This seems like the wrong values
-				  ;;-- need to subtract thickness
-				  minx
-				  miny)
-		      points
-		      j))))))))))
+		   (clim-internals::with-half-thickness-1 (lthickness rthickness) thickness
+                     (declare (ignore rthickness))
+		     (setq thickness (round thickness))
+		       (let ((points (tk::make-xarc-array :number xpoints)))
+			 (macrolet ((guts (x y)
+				      `(let ((x ,x)
+					     (y ,y))
+					 (transform-positions transform x y)
+					 (with-fixnums ((x (- x lthickness))
+							(y (- y lthickness)))
+					   (when (valid-point-p x y)
+					     (minf minx x)
+					     (minf miny y)
+					     (setf (tk::xarc-array-x points j) x
+						   (tk::xarc-array-y points j) y
+						   (tk::xarc-array-width points j) thickness
+						   (tk::xarc-array-height points j) thickness
+						   (tk::xarc-array-angle1 points j) 0
+						   (tk::xarc-array-angle2 points j) #.(* 360 64))
+					     (incf j))))))
+			   (inner-guts))
+			 (x11::xfillarcs
+			  (tk::object-display drawable)
+			  drawable
+			  (adjust-ink (decode-ink ink medium)
+				      medium
+				      minx
+				      miny)
+			  points
+			  j)))))))))))
 
 
 (defmethod medium-draw-line* ((medium xt-medium) x1 y1 x2 y2)
@@ -1137,7 +1200,35 @@
 	       points
 	       i))))))))
 
-(defmethod medium-draw-rectangle* ((medium xt-medium) x1 y1 x2 y2 filled)
+(defmacro with-clipped-fixnum-rectangle ((x1 y1 x2 y2) &body body)
+  `(with-single-floats ((x1 ,x1) (y1 ,y1) (x2 ,x2) (y2 ,y2))
+     (unless (single-float-valid-point-p x1 y1)
+       (setq x1 (min (max -32000s0 x1) 32000s0))
+       (setq y1 (min (max -32000s0 y1) 32000s0)))
+     (unless (single-float-valid-point-p x2 y2)
+       (setq x2 (min (max -32000s0 x2) 32000s0))
+       (setq y2 (min (max -32000s0 y2) 32000s0)))
+     (with-mins-and-maxes ((min-x max-x x1 x2)
+			   (min-y max-y y1 y2))
+       (with-fixnums ((fmin-x min-x)
+		      (fmin-y min-y)
+		      (fwidth (- max-x min-x))
+		      (fheight (- max-y min-y)))
+	 ,@body))))
+
+#+debugging
+(defmacro print-variables (&rest variables)
+  `(format excl::*initial-terminal-io*
+	   ,(with-output-to-string (s)
+	     (dolist (var variables)
+	       (format s "~S = " var)
+	       (write-string "~S, " s))
+	     (write-string "~%" s))
+	   ,@variables))
+
+(defmethod medium-draw-rectangle* ((medium xt-medium) ox1 oy1 ox2 oy2 filled)
+  #+this-would-be-nice (declare (optimize (safety 0) (speed 3)))
+  #-this-would-be-nice (declare (optimize (safety 3) (speed 0)))
   (let ((drawable (medium-drawable medium)))
     (when drawable
       (let* ((ink (medium-ink medium))
@@ -1145,28 +1236,21 @@
 	     (transform (sheet-device-transformation sheet)))
 	(assert (rectilinear-transformation-p transform))
 	;;--rounding
-	(convert-to-device-coordinates transform x1 y1 x2 y2)
+	(transform-positions transform ox1 oy1 ox2 oy2)
 	;; Clipping a rectangle is ridiculously easy.
-	(unless (valid-point-p x1 y1)
-	  (setq x1 (min (max -32000 (the fixnum x1)) 32000))
-	  (setq y1 (min (max -32000 (the fixnum y1)) 32000)))
-	(unless (valid-point-p x2 y2)
-	  (setq x2 (min (max -32000 (the fixnum x2)) 32000))
-	  (setq y2 (min (max -32000 (the fixnum y2)) 32000)))
-	(let ((min-x (min (the fixnum x1) (the fixnum x2)))
-	      (min-y (min (the fixnum y1) (the fixnum y2))))
-	  (declare (fixnum min-x min-y))
+	(with-clipped-fixnum-rectangle (ox1 oy1 ox2 oy2)
 	  (tk::draw-rectangle
 	   drawable
 	   (adjust-ink (decode-ink ink medium)
 		       medium
-		       min-x min-y)
-	   min-x min-y
-	   (fast-abs (the fixnum (- (the fixnum x2) (the fixnum x1))))
-	   (fast-abs (the fixnum (- (the fixnum y2) (the fixnum y1))))
+		       fmin-x fmin-y)
+	   fmin-x fmin-y
+	   fwidth
+	   fheight
 	   filled))))))
 
 (defmethod medium-draw-rectangles* ((medium xt-medium) rectangles filled) 
+  (declare (optimize (speed 3) (safety 0)))
   (let ((drawable (medium-drawable medium)))
     (when drawable
       (let* ((ink (medium-ink medium))
@@ -1177,39 +1261,33 @@
 	     (rects (xt::make-xrectangle-array :number nrects))
 	     (overall-min-x #.(1- (ash 1 16)))
 	     (overall-min-y #.(1- (ash 1 16))))
+	(declare (fixnum len nrects overall-min-x overall-min-y))
 	(assert (zerop (mod len 4)) () "Must be a multiple of 4")
 	(assert (rectilinear-transformation-p transform))
 	(macrolet ((guts (x1 y1 x2 y2)
 		     `(let ((x1 ,x1) (y1 ,y1) (x2 ,x2) (y2 ,y2))
-			;;--rounding
-			(convert-to-device-coordinates transform x1 y1 x2 y2)
-			;; Clipping a rectangle is ridiculously easy.
-			(unless (valid-point-p x1 y1)
-			  (setq x1 (min (max -32000 (the fixnum x1)) 32000))
-			  (setq y1 (min (max -32000 (the fixnum y1)) 32000)))
-			(unless (valid-point-p x2 y2)
-			  (setq x2 (min (max -32000 (the fixnum x2)) 32000))
-			  (setq y2 (min (max -32000 (the fixnum y2)) 32000)))
-			(let ((min-x (min (the fixnum x1) (the fixnum x2)))
-			      (min-y (min (the fixnum y1) (the fixnum y2)))
-			      (max-x (max (the fixnum x1) (the fixnum x2)))
-			      (max-y (max (the fixnum y1) (the fixnum y2))))
-			  (declare (fixnum min-x min-y max-x max-y))
-			  (minf overall-min-x min-x)
-			  (minf overall-min-y min-y)
-			  (setf (tk::xrectangle-array-x rects i) min-x 
-				(tk::xrectangle-array-y rects i) min-y
-				(tk::xrectangle-array-width rects i) (- max-x min-x)
-				(tk::xrectangle-array-height rects i) (- max-y min-y))
+			(transform-positions transform x1 y1 x2 y2)
+			(with-clipped-fixnum-rectangle (x1 y1 x2 y2)
+			  (minf overall-min-x fmin-x)
+			  (minf overall-min-y fmin-y)
+			  (setf (tk::xrectangle-array-x rects i) fmin-x 
+				(tk::xrectangle-array-y rects i) fmin-y
+				(tk::xrectangle-array-width rects i) fwidth
+				(tk::xrectangle-array-height rects i) fheight)
 			  (incf i)))))
 	  (let ((i 0))
+	    (declare (fixnum i))
 	    (if (listp rectangles)
 		(loop
 		  (when (null rectangles) (return nil))
 		  (guts (pop rectangles) (pop rectangles) (pop rectangles) (pop rectangles)))
 	      (do ((j 0 (+ j 4)))
 		  ((= j len))
-		(guts (aref rectangles j) (aref rectangles (+ 1 j)) (aref rectangles (+ 2 j)) (aref rectangles (+ 3 j))))))
+		(declare (fixnum j))
+		(guts (aref rectangles j)
+		      (aref rectangles (+ 1 j))
+		      (aref rectangles (+ 2 j))
+		      (aref rectangles (+ 3 j))))))
 	  (tk::draw-rectangles
 	   drawable
 	   (adjust-ink (decode-ink ink medium)
@@ -1288,34 +1366,72 @@
 				 center-x center-y
 				 radius-1-dx radius-1-dy radius-2-dx radius-2-dy 
 				 start-angle end-angle filled)
+  (declare (optimize (speed 3) (safety 0)))
   (let ((drawable (medium-drawable medium)))
     (when drawable
       (let* ((sheet (medium-sheet medium))
 	     (transform (sheet-device-transformation sheet)))
-	(convert-to-device-coordinates transform center-x center-y)
-	(discard-illegal-coordinates medium-draw-ellipse* center-x center-y)
-	(convert-to-device-distances transform 
-	  radius-1-dx radius-1-dy radius-2-dx radius-2-dy)
+	(transform-positions transform center-x center-y)
+	(transform-distances transform radius-1-dx radius-1-dy radius-2-dx radius-2-dy)
 	;;--- This is some magic that means that things get drawn
 	;;--- correctly.
-	(setq start-angle (- 2pi start-angle)
-	      end-angle (- 2pi end-angle))
-	(rotatef start-angle end-angle)
-	(when (< end-angle start-angle)
-	  (setq end-angle (+ end-angle 2pi)))
-	;;--rounding in draw-ellipse
-	(tk::draw-ellipse
-	  drawable
-	  (adjust-ink (decode-ink (medium-ink medium) medium)
-		      medium
-		      (- center-x 
-			 (abs (if (zerop radius-1-dx) radius-2-dx radius-1-dx)))
-		      (- center-y 
-			 (abs (if (zerop radius-1-dy) radius-2-dy radius-1-dy))))
-	  center-x center-y
-	  radius-1-dx radius-1-dy radius-2-dx radius-2-dy 
-	  start-angle end-angle 
-	  filled)))))
+	(with-single-floats (center-x center-y radius-1-dx radius-1-dy
+				      radius-2-dx radius-2-dy
+				      start-angle end-angle)
+	  (setq start-angle (- 2pi start-angle)
+		end-angle (- 2pi end-angle))
+	  (rotatef start-angle end-angle)
+	  (when (< end-angle start-angle)
+	    (setq end-angle (+ end-angle 2pi)))
+	  ;;--rounding in draw-ellipse
+	  (with-single-floats ((x-radius 0)
+			       (y-radius 0))
+	  
+	    (cond ((and (= radius-1-dx 0) (= radius-2-dy 0))
+		   (setq x-radius (abs radius-2-dx)
+			 y-radius (abs radius-1-dy)))
+		  ((and (= radius-2-dx 0) (= radius-1-dy 0))
+		   (setq x-radius (abs radius-1-dx)
+			 y-radius (abs radius-2-dy)))
+		  (t
+		   (let ((s-1 (+ (* radius-1-dx radius-1-dx) 
+				 (* radius-1-dy radius-1-dy)))
+			 (s-2 (+ (* radius-2-dx radius-2-dx) 
+				 (* radius-2-dy radius-2-dy))))
+		     (if (= s-1 s-2)
+			 (let ((r (sqrt s-1)))
+			   (setq x-radius r y-radius r))
+		       ;; Degrade to drawing a rectilinear ellipse
+		       (setq x-radius (sqrt s-1) 
+			     y-radius (sqrt s-2))))))
+	  
+	    (setq start-angle (* start-angle #.(float (/ (* 360 64) (* 2 pi)) 0s0)))
+	    (setq end-angle (* end-angle #.(float (/ (* 360 64) (* 2 pi)) 0s0)))
+
+	    ;;--rounding
+	    (if (> end-angle start-angle)
+		(setq end-angle (- end-angle start-angle))
+	      (setq end-angle (- start-angle end-angle)))
+	    
+	    (with-fixnums ((x-min (- center-x x-radius))
+			   (y-min (- center-y y-radius))
+			   (width (* 2 x-radius))
+			   (height (* 2 y-radius))
+			   end-angle
+			   start-angle)
+	      (discard-illegal-coordinates medium-draw-ellipse* x-min y-min)
+	      (tk::draw-ellipse-1 drawable 
+				  (adjust-ink (decode-ink (medium-ink medium) medium)
+					      medium
+					      x-min
+					      y-min)
+				  x-min
+				  y-min 
+				  width 
+				  height
+				  start-angle
+				  end-angle
+				  filled))))))))
 
 (defmethod medium-draw-text* ((medium xt-medium)
 			      string-or-char x y start end
@@ -1328,14 +1444,13 @@
 	     (transform (sheet-device-transformation sheet))
 	     (text-style (medium-merged-text-style medium))
 	     (font (text-style-mapping port text-style))
-	     (ascent (tk::font-ascent font)))
+	     (descent (tk::font-descent font))
+	     (ascent (tk::font-ascent font))
+	     (height (+ ascent descent)))
 	;;--rounding errors?
-	;;--Well we do some arithmetic in some cases
-	;;--so in theory it could go wrong.
-	(convert-to-device-coordinates transform x y)
-	(discard-illegal-coordinates medium-draw-text* x y)
+	(transform-positions transform x y)
 	(when towards-x
-	  (convert-to-device-coordinates transform towards-x towards-y))
+	  (transform-positions transform towards-x towards-y))
 	(when (typep string-or-char 'character)
 	  (setq string-or-char (string string-or-char)))
 	(ecase align-x
@@ -1353,18 +1468,20 @@
 	  (:left nil))
 	(ecase align-y
 	  (:bottom
-	   (let ((dy (text-style-descent text-style medium)))
+	   (let ((dy descent))
 	     (decf y dy)
 	     (when towards-y (decf towards-y dy))))
 	  (:center 
-	   (let ((dy (- (text-style-descent text-style medium)
-			(floor (text-style-height text-style medium) 2))))
+	   (let ((dy (- descent
+			(floor height 2))))
 	     (decf y dy)
 	     (when towards-y (decf towards-y dy))))
 	  (:baseline nil)
 	  (:top
 	   (when towards-y (incf towards-y ascent))
 	   (incf y ascent))) 
+	(fix-coordinates x y)
+	(discard-illegal-coordinates medium-draw-text* x y)
         (let ((gc (adjust-ink
 		   (decode-ink (medium-ink medium) medium)
 		   medium
diff --git a/tk/foreign.lisp b/tk/foreign.lisp
index d293f50e8627cdd0808d41300b54a215abae9cb7..440306486eba0a2fe24f939bb0fd0c1a62b2d590 100644
--- a/tk/foreign.lisp
+++ b/tk/foreign.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: foreign.lisp,v 1.14 93/01/11 15:45:37 colin Exp $
+;; $fiHeader: foreign.lisp,v 1.15 1993/07/27 01:52:52 colin Exp $
 
 (in-package :tk)
 
@@ -52,6 +52,8 @@
 (defun create-application-context ()
   (make-instance 'application-context))
 
+(defparameter *large-connection-quantum* 20)
+
 (defun open-display (&key (context (create-application-context))
 			  (host nil)
 			  (application-name "clim")
@@ -61,14 +63,14 @@
 			  (argc 0)
 			  (argv 0))
   (let ((d (with-ref-par ((argc argc))
-	     (xt_open_display context
-			      (or host 0)
-			      application-name
-			      application-class
-			      options 
-			      num-options
-			      argc
-			      argv))))
+	     (let ((temp (mp:process-quantum mp:*current-process*)))
+	       (unwind-protect
+		   (progn (setf (mp:process-quantum mp:*current-process*) *large-connection-quantum*)
+			  (mp:process-allow-schedule)
+			  (xt_open_display context (or host 0) application-name application-class options
+					   num-options argc argv))
+		 (setf (mp:process-quantum mp:*current-process*) temp)
+		 (mp:process-allow-schedule))))))
     (if (zerop d)
 	(error "cannot open the display: ~A" host))
     ;; Used for debugging:
diff --git a/tk/graphics.lisp b/tk/graphics.lisp
index 7f8084b72c0f521d34ab6167094d565b9c7442f8..fa90c3402d745ed20beb7fc952e1bf33a6df8058 100644
--- a/tk/graphics.lisp
+++ b/tk/graphics.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: graphics.lisp,v 1.14 1993/07/27 01:52:59 colin Exp $
+;; $fiHeader: graphics.lisp,v 1.15 1993/09/17 19:06:42 cer Exp $
 
 (in-package :tk)
 
@@ -43,60 +43,62 @@
    y2))
 
 
-(defun draw-ellipse (drawable gcontext center-x 
-		     center-y
-		     radius-1-dx 
-		     radius-1-dy 
-		     radius-2-dx
-		     radius-2-dy 
-		     start-angle 
-		     end-angle 
-		     filled)
-  (multiple-value-bind (x-radius y-radius)
-      (cond ((and (= radius-1-dx 0) (= radius-2-dy 0))
-	     (values (round (abs radius-2-dx))
-		     (round (abs radius-1-dy))))
-	    ((and (= radius-2-dx 0) (= radius-1-dy 0))
-	     (values (round (abs radius-1-dx))
-		     (round (abs radius-2-dy))))
-	    (t
-	     (let ((s-1 (+ (* radius-1-dx radius-1-dx) 
-			   (* radius-1-dy radius-1-dy)))
-		   (s-2 (+ (* radius-2-dx radius-2-dx) 
-			   (* radius-2-dy radius-2-dy))))
-	       (if (= s-1 s-2)
-		   (let ((r (round (sqrt s-1))))
-		     (values r r))
-		 ;; Degrade to drawing a rectilinear ellipse
-		 (values (round (sqrt s-1)) 
-			 (round (sqrt s-2)))))))
-    (setq start-angle (round (* start-angle (/ (* 360 64) (* 2 pi)))))
-    (setq end-angle (round (* end-angle (/ (* 360 64) (* 2 pi)))))
-    ;;--rounding
-    (if (> end-angle start-angle)
-	(setq end-angle (- end-angle start-angle))
-      (setq end-angle (- start-angle end-angle)))
-    (if filled
-	(x11:xfillarc
-	 (object-display drawable)
-	 drawable
-	 gcontext
-	 ;;--rounding
-	 (- center-x x-radius)
-	 (- center-y y-radius)
-	 (* 2 x-radius)
-	 (* 2 y-radius)
-	 start-angle end-angle)
-      (x11:xdrawarc
+;(defun draw-ellipse (drawable gcontext center-x 
+;		     center-y
+;		     radius-1-dx 
+;		     radius-1-dy 
+;		     radius-2-dx
+;		     radius-2-dy 
+;		     start-angle 
+;		     end-angle 
+;		     filled)
+;  (multiple-value-bind (x-radius y-radius)
+;      (cond ((and (= radius-1-dx 0) (= radius-2-dy 0))
+;	     (values (round (abs radius-2-dx))
+;		     (round (abs radius-1-dy))))
+;	    ((and (= radius-2-dx 0) (= radius-1-dy 0))
+;	     (values (round (abs radius-1-dx))
+;		     (round (abs radius-2-dy))))
+;	    (t
+;	     (let ((s-1 (+ (* radius-1-dx radius-1-dx) 
+;			   (* radius-1-dy radius-1-dy)))
+;		   (s-2 (+ (* radius-2-dx radius-2-dx) 
+;			   (* radius-2-dy radius-2-dy))))
+;	       (if (= s-1 s-2)
+;		   (let ((r (round (sqrt s-1))))
+;		     (values r r))
+;		 ;; Degrade to drawing a rectilinear ellipse
+;		 (values (round (sqrt s-1)) 
+;			 (round (sqrt s-2)))))))
+;    (setq start-angle (round (* start-angle (/ (* 360 64) (* 2 pi)))))
+;    (setq end-angle (round (* end-angle (/ (* 360 64) (* 2 pi)))))
+;    ;;--rounding
+;    (if (> end-angle start-angle)
+;	(setq end-angle (- end-angle start-angle))
+;      (setq end-angle (- start-angle end-angle)))
+;    (draw-ellipse-1 drawable 
+;		    gcontext 
+;		    (- center-x x-radius)
+;		    (- center-y y-radius)
+;		    (* 2 x-radius)
+;		    (* 2 y-radius) 
+;		    start-angle end-angle filled)))
+
+
+(defun draw-ellipse-1 (drawable gcontext x y width height start-angle end-angle filled)
+  (if filled
+      (x11:xfillarc
        (object-display drawable)
        drawable
        gcontext
-       ;;--rounding
-       (- center-x x-radius)
-       (- center-y y-radius)
-       (* 2 x-radius)
-       (* 2 y-radius)
-       start-angle end-angle))))
+       x y width height
+       start-angle end-angle)
+    (x11:xdrawarc
+     (object-display drawable)
+     drawable
+     gcontext
+     x y width height
+     start-angle end-angle)))
 
 
 (defun draw-rectangle (drawable gcontext x y width height &optional
diff --git a/tk/widget.lisp b/tk/widget.lisp
index 5560f24a81f8ea1f154f7ed6c01127e63c505c21..d0997495571e3e434c7e72cd3341be0dacf9b3fb 100644
--- a/tk/widget.lisp
+++ b/tk/widget.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: widget.lisp,v 1.32 1993/08/12 16:04:46 cer Exp $
+;; $fiHeader: widget.lisp,v 1.33 1993/09/17 19:06:47 cer Exp $
 
 (in-package :tk)
 
@@ -277,16 +277,30 @@
 ;; note that this is different from xt-initialize which calls
 ;; XtToolkitInitialize. This is closer to XtAppInitialize
 
+(defvar *fallback-resources* '("clim*dragInitiatorProtocolStyle: DRAG_NONE"
+			       "clim*dragreceiverprotocolstyle:	DRAG_NONE"
+			       )
+  "A list of resource specification strings")
+
 (defun initialize-toolkit (&rest args)
-  (let* ((context (create-application-context))
-	 (display (apply #'make-instance 'display 
-			 :context context
-			 args))
-	 (app (apply #'app-create-shell 
-		     :display display
-		     :widget-class 'application-shell
-		     args)))
-    (values context display app)))
+  (let* ((context (create-application-context)))
+    (when *fallback-resources*
+      (xt_app_set_fallback_resources 
+       context
+       (let* ((n (length *fallback-resources*))
+	      (v (make-array (1+ n) :element-type '(unsigned-byte 32))))
+	 (dotimes (i n)
+	   (setf (aref v i) (ff:string-to-char* (nth i *fallback-resources*))))
+	 (setf (aref v n) 0)
+	 v)))
+    (let* ((display (apply #'make-instance 'display 
+			   :context context
+			   args))
+	   (app (apply #'app-create-shell 
+		       :display display
+		       :widget-class 'application-shell
+		       args)))
+      (values context display app))))
 
 
 (defun xt-name (w) (char*-to-string (xt_name w)))
diff --git a/tk/xt-funs.lisp b/tk/xt-funs.lisp
index d3546684789f067afd0cbad27e2e7c654317864c..7fefd48b26bb6a0077b3dd70b0a57fbaf61a52ca 100644
--- a/tk/xt-funs.lisp
+++ b/tk/xt-funs.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-funs.lisp,v 1.20 1993/07/29 20:52:02 layer Exp $
+;; $fiHeader: xt-funs.lisp,v 1.21 1993/08/12 16:04:55 cer Exp $
 
 
 ;;
@@ -423,3 +423,10 @@
 
 
 
+(ff:defforeign 'xt_app_set_fallback_resources
+    :call-direct t
+    :arguments '(foreign-address foreign-address)
+    :arg-checking nil
+    :entry-point (ff:convert-to-lang "XtAppSetFallbackResources")
+    :return-type :void)
+