diff --git a/ChangeLog.n b/ChangeLog.n
index cf5fba2ffddb5af3e5b878ebdb848a8728d6979d..f3107f421bbf7f42dc84e28f2cf34e3d03475fd4 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -1,3 +1,60 @@
+from colin: Mon Oct 25 20:19:08 PDT 1993
+
+Makefile.defs
+- added -backtrace-on-error to training
+
+clim/command.lisp
+- fixed bad delete in remove-presentation-translator-from-command-table 
+- fixed pointer-documentation bug in write-command-argument-translators
+
+clim/coordinate-sorted-set.lisp
+- added a recompute-extent-for-changed-child :after method to reposition
+  output record in vector when it moves
+
+clim/recording-protocol.lisp
+- added convert-from-child-to-parent-coordinates
+- fixed recompute-extent-for-changed-child
+- fixed a bunch of functions doing incorrect translations before
+  calling recompute-extent-for-changed-child
+
+clim/table-formatting.lisp
+- changed tree-recompute-extent-1 (output-record-mixin)
+
+clim/text-formatting.lisp
+- fixed invoke-indenting-output when cursor-x-pos non 0
+
+clim/text-recording.lisp
+- fixed call to recompute-extent-for-changed-child
+
+demo/demo-driver.lisp
+- added :background arg to run-demo
+- fixed up *package* for background processes
+
+demo/graphics-editor.lisp
+- added :initial-cursor-visibility nil
+
+demo/db-scroll.lisp
+- fixed scroll-extent so that it calls note-viewport-position-changed when
+  pane scrolls 
+
+tk/convenience.lisp tk/make-classes.lisp tk/make-widget.lisp
+tk/ol-init.lisp tk/ol-widgets.lisp tk/widget.lisp, tk/xm-widgets.lisp,
+tk-silica/xm-gadgets.lisp tk-silica/xt-gadgets.lisp tk-silica/xm-frames.lisp 
+- various changes to handle :name correctly - ie translate lisp name to tk
+  name sensibly
+
+tk-silica/xt-gadgets.lisp
+- added method mirror-region* (xt-port xt-top-level-sheet)
+
+
+tk-silica/ol-gadgets.lisp, tk-silica/xm-frames.lisp
+- :divider type for command-menu-items now handles :value of :line
+
+tk/xlib.lisp
+- added support for X cut-buffer
+
+-------------------------------------------------------------------------------
+
 from cer: Mon Oct 25 09:13:49 PDT 1993
 
 Makefile.defs			Removed clim-motif_d.o from default build
diff --git a/Makefile.defs b/Makefile.defs
index 64c3f8830cd23f88433867df6b501219b8096b5d..6800dacbb5d06a005fa9943f276ab7b71120fbad 100644
--- a/Makefile.defs
+++ b/Makefile.defs
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.defs,v 1.23 1993/09/22 21:20:56 cer Exp $
+# $fiHeader: Makefile.defs,v 1.24 1993/10/25 16:15:06 cer Exp $
 #
 #  Makefile.defs for CLIM 2.0
 #
@@ -47,7 +47,7 @@ TRAIN_TEXT = \
 	$(ECHO) "\
 	$(TRAIN_LISP) \
 	(exit 0) \
-" | $(CLIM) $(CLOPTS) -batch \
+" | $(CLIM) $(CLOPTS) -batch -backtrace-on-error \
 	; echo CLIM trained!!!!	
 
 REPORT_FILE=dunno
diff --git a/clim/command.lisp b/clim/command.lisp
index 9deedaacd515db7d3c65220023c1b9d07f12d81b..9cb9bce8ae990a05501b6e0e157eed88398b7b68 100644
--- a/clim/command.lisp
+++ b/clim/command.lisp
@@ -1,6 +1,6 @@
 s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: command.lisp,v 1.24 93/04/27 15:49:24 cer Exp $
+;; $fiHeader: command.lisp,v 1.25 1993/06/04 16:06:20 cer Exp $
 
 (in-package :clim-internals)
 
@@ -870,12 +870,14 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 							  &key (errorp t))
   (setq command-table (find-command-table command-table))
   (with-slots (translators) command-table
-    (let ((translator
+    (let* ((translator
 	    (if (symbolp translator-name)
-		(find-presentation-translator translator-name command-table :errorp nil)
-		translator-name)))
-      (cond ((find translator translators)
-	     (setq translators (delete translator translators))
+		(find-presentation-translator translator-name command-table
+					      :errorp nil)
+	      translator-name))
+	   (place (position translator translators)))
+      (cond (place
+	     (setf (aref translators place) (vector-pop translators))
 	     (incf *translators-cache-tick*))
 	    (t
 	     (when errorp
@@ -1137,8 +1139,8 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 		       (push `(define-presentation-to-command-translator ,translator-name
 				  (,arg-type ,command-name ,command-table
 				   :gesture ,gesture
-				   :pointer-documentation ,pointer-documentation
-				   ,@translator-options)
+				   ,@translator-options
+				   :pointer-documentation ,pointer-documentation)
 				  (object)
 				,(if found-key
 				     `(list ,@(unsupplied n-required)
diff --git a/clim/coordinate-sorted-set.lisp b/clim/coordinate-sorted-set.lisp
index 00b39f40f39cf37cb184de5b7e0a904f84046fda..851080f5d9536fc5b41a634ecbfb2c78a622b7dd 100644
--- a/clim/coordinate-sorted-set.lisp
+++ b/clim/coordinate-sorted-set.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: coordinate-sorted-set.lisp,v 1.7 92/12/03 10:26:12 cer Exp $
+;; $fiHeader: coordinate-sorted-set.lisp,v 1.8 1993/07/27 01:38:37 colin Exp $
 
 (in-package :clim-internals)
 
@@ -63,6 +63,52 @@
     (fill coordinate-sorted-set nil :start 0 :end fill-pointer)
     (setf fill-pointer 0)))
 
+(defmethod recompute-extent-for-changed-child :after
+	   ((record standard-tree-output-record) child
+	    old-left old-top old-right old-bottom)
+  (declare (ignore old-left old-top old-right old-bottom))
+  (with-slots (coordinate-sorted-set fill-pointer tallest-box-height) record
+    (maxf tallest-box-height (bounding-rectangle-height child))
+    (with-bounding-rectangle* (left top right bottom) child
+      (declare (ignore left top))
+      (let ((fp fill-pointer)
+	    (vector coordinate-sorted-set))
+	(declare (type simple-vector vector) (type fixnum fp))
+	(unless (eql fp 1)
+	  (let ((old-index
+		 (or (coordinate-sorted-set-position
+		      child vector fp)
+		     ;; If we couldn't find it with the binary search, try
+		     ;; again the hard way.  If these things were more
+		     ;; disciplined with respect to managing overlapping
+		     ;; records, we wouldn't have to resort to this.
+		     (position child vector))))
+	    (declare (type fixnum old-index))
+	    (when old-index
+	      (let ((new-index (coordinate-sorted-set-index-for-position
+				vector right bottom 0 fp)))
+		(declare (type fixnum new-index))
+		(unless (eql old-index new-index)
+		  ;; Effectively child is removed from position
+		  ;; old-index and then added at new-index. However
+		  ;; the following code does both of these in one
+		  ;; operation. The removal operation would cause all
+		  ;; indices to the right to be offset by one - so
+		  ;; when new-index is greater than old-index we must
+		  ;; decrement it in order to get the right place (cim)
+		  (when (> new-index old-index)
+		    (decf new-index))
+		  (let ((d (signum (- new-index old-index))))
+		    (declare (type fixnum d))
+		    (do* ((i old-index j)
+			  (j (+ i d) (+ i d)))
+			((eql i new-index))
+		      (declare (type fixnum i j)
+			       (optimize (speed 3) (safety 0)))
+		      (setf (svref vector i) (svref vector j))))
+		  (setf (svref vector new-index) child))))))))))
+
+
 (defmethod add-output-record (child (record standard-tree-output-record))
   (with-slots (coordinate-sorted-set fill-pointer tallest-box-height) record
     (let ((vector coordinate-sorted-set)
diff --git a/clim/recording-protocol.lisp b/clim/recording-protocol.lisp
index 244e90a0d1da7247a550c26f97b20b8e38cbb16c..445a0bab42e154a5529a67d08d2bb460e77dd994 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.36 1993/09/17 19:05:23 cer Exp $
+;; $fiHeader: recording-protocol.lisp,v 1.37 1993/10/25 16:15:37 cer Exp $
 
 (in-package :clim-internals)
 
@@ -297,8 +297,8 @@
 (defun offset-region-contains-position-p (region xoff yoff x y)
   (declare (type coordinate xoff yoff x y))
    (with-bounding-rectangle* (left top right bottom) region
-     (ltrb-contains-position-p (+ left xoff) (+ top yoff) (+ right xoff) (+ bottom yoff)
-			       x y)))
+     (ltrb-contains-position-p left top right bottom
+			       (- x xoff) (- y yoff))))
 
 ;;; This maps over all of the children of the record
 #+Genera (zwei:defindentation (map-over-output-records 1 1))
@@ -503,6 +503,13 @@
 	     (declare (type coordinate our-x our-y))
 	     (values (+ our-x x) (+ our-y y)))))))
 
+;; CONVERT-FROM-CHILD-TO-PARENT-COORDINATE returns an x,y offset pair
+;; that can be ADDED to any coordinates relative to RECORD in
+;; order to get coordinates relative to the parent of RECORD
+
+(defun-inline convert-from-child-to-parent-coordinates (record)
+  (output-record-position record))
+  
 
 ;;; Rest of stuff started in clim-defs...
 (defun construct-output-record-1 (type &rest initargs)
@@ -723,22 +730,21 @@
 (defmethod recompute-extent-for-changed-child ((record output-record-mixin) child
 					       old-left old-top old-right old-bottom)
   (declare (type coordinate old-top old-right old-bottom))
-  ;; old edges are passed in parent's coordinate system because
-  ;; their reference point may have changed.
   ;; (assert (child-completely-contained-within-extent-of record child))
-  (with-slots (parent) record
-    (with-bounding-rectangle* (left top right bottom) record
-      ;; We must recompute the extent if the child is not completely contained
-      ;; or if it used to "define" one of the old edges.
-      ;; A picture would help, but we're not going to draw it here. (:-)
-      (multiple-value-bind (xoff yoff)
-	  (convert-from-descendant-to-ancestor-coordinates record parent)
-	(when (or (not (region-contains-offset-region-p record child xoff yoff))
-		  (= old-left left)
-		  (= old-top top)
-		  (= old-right right)
-		  (= old-bottom bottom))
-	  (recompute-extent record))))))
+  (with-bounding-rectangle* (left top right bottom) record
+    ;; We must recompute the extent if the child is not completely contained
+    ;; or if it used to "define" one of the old edges.
+    ;; A picture would help, but we're not going to draw it here. (:-)
+    (multiple-value-bind (xoff yoff)
+	(convert-from-child-to-parent-coordinates record)
+      (translate-coordinates xoff yoff
+			     old-left old-top old-right old-bottom)
+      (when (or (not (region-contains-offset-region-p record child xoff yoff))
+		(= old-left left)
+		(= old-top top)
+		(= old-right right)
+		(= old-bottom bottom))
+	(recompute-extent record)))))
 
 (defmethod recompute-extent ((record output-record-mixin))
   (with-slots (parent) record
@@ -765,7 +771,7 @@
 	  (declare (dynamic-extent #'recompute-extent-of-child))
 	  (map-over-output-records #'recompute-extent-of-child record))
 	(multiple-value-bind (xoff yoff)
-	    (convert-from-descendant-to-ancestor-coordinates record parent)
+	    (convert-from-child-to-parent-coordinates record)
 	  (declare (type coordinate xoff yoff))
 	  (if once
 	      (progn (assert (ltrb-well-formed-p min-x min-y max-x max-y))
@@ -776,10 +782,7 @@
 	      ;; No children
 	      (bounding-rectangle-set-edges record
 					    (coordinate 0) (coordinate 0)
-					    (coordinate 0) (coordinate 0)))
-	  ;; Pass these coordinates in parent's coordinate system (I think)
-	  (translate-coordinates xoff yoff
-	    old-left old-top old-right old-bottom))
+					    (coordinate 0) (coordinate 0))))
 	(when parent
 	  (recompute-extent-for-changed-child
 	    parent record old-left old-top old-right old-bottom))))))
@@ -793,11 +796,9 @@
 	    (old-bottom bottom))
 	(with-bounding-rectangle* (eleft etop eright ebottom) child
 	  (multiple-value-bind (xoff yoff)
-	      (convert-from-descendant-to-ancestor-coordinates record parent)
+	      (convert-from-child-to-parent-coordinates record)
 	    (translate-coordinates xoff yoff
-	      eleft etop eright ebottom
-	      ;; pass these coordinates in parent's coordinate system.
-	      old-left old-top old-right old-bottom))
+	      eleft etop eright ebottom))
 	  (cond ((= (output-record-count record :fastp t) 1)
 		 (bounding-rectangle-set-edges record eleft etop eright ebottom))
 		(t (bounding-rectangle-set-edges record
@@ -811,12 +812,6 @@
 (defmethod tree-recompute-extent ((record output-record-element-mixin))
   (with-bounding-rectangle* (old-left old-top old-right old-bottom) record
     (let ((parent (output-record-parent record)))
-      (multiple-value-bind (xoff yoff)
-	  (convert-from-descendant-to-ancestor-coordinates record parent)
-	(declare (type coordinate xoff yoff))
-	;; we must pass the old coordinates in the parent's coordinate system
-	;; because tree-recompute-extent-1 may adjust the reference point.
-	(translate-coordinates xoff yoff old-left old-top old-right old-bottom))
       (tree-recompute-extent-1 record)
       (when parent
 	(recompute-extent-for-changed-child
@@ -850,12 +845,9 @@
 	   (child (record output-record-mixin) &optional (errorp t))
   (declare (ignore errorp))
   (with-bounding-rectangle* (left top right bottom) child
-    (multiple-value-bind (xoff yoff)
-	(convert-from-descendant-to-ancestor-coordinates child record)
-      (declare (type coordinate xoff yoff))
-      (translate-coordinates xoff yoff left top right bottom)
-      (recompute-extent-for-changed-child record child left top right bottom)))
-  (setf (output-record-parent child) nil))	;in case other things are still pointing to it.
+    (recompute-extent-for-changed-child record child left top right bottom))
+  ;;in case other things are still pointing to it.
+  (setf (output-record-parent child) nil))
 
 (defmethod delete-output-record :around (child (record output-record-mixin) &optional errorp)
   (declare (ignore errorp))
diff --git a/clim/table-formatting.lisp b/clim/table-formatting.lisp
index dd9bfbe965e5521f88a5a9b54ae2756ca89d5034..4283587905188c64b9263a358f27132b1abb33b2 100644
--- a/clim/table-formatting.lisp
+++ b/clim/table-formatting.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: table-formatting.lisp,v 1.18 92/12/16 16:47:02 cer Exp $
+;; $fiHeader: table-formatting.lisp,v 1.19 1993/07/27 01:41:23 colin Exp $
 
 (in-package :clim-internals)
 
@@ -176,8 +176,7 @@
 	(max-y (coordinate 0)))
     (declare (type coordinate min-x min-y max-x max-y))
     (multiple-value-bind (x-offset y-offset)
-	(convert-from-descendant-to-ancestor-coordinates
-	  record (output-record-parent record))
+	(convert-from-child-to-parent-coordinates record)
       (declare (type coordinate x-offset y-offset))
       (flet ((recompute-extent-of-child (child)
 	       (multiple-value-bind (left top right bottom)
@@ -196,11 +195,6 @@
 			      once  t))))))
 	(declare (dynamic-extent #'recompute-extent-of-child))
 	(map-over-output-records #'recompute-extent-of-child record))
-      (when (null min-x)
-	(setq min-x (coordinate 0)
-	      min-y (coordinate 0)
-	      max-x (coordinate 0)
-	      max-y (coordinate 0)))
       #+++ignore (assert (ltrb-well-formed-p min-x min-y max-x max-y))
       (translate-coordinates x-offset y-offset min-x min-y max-x max-y)
       (bounding-rectangle-set-edges record min-x min-y max-x max-y)
diff --git a/clim/text-formatting.lisp b/clim/text-formatting.lisp
index d15a11c13f8429bc65e7f6a0e212186bcbae3dd5..845212ec66a6be78f054888fe1e6a0d4e72d73e3 100644
--- a/clim/text-formatting.lisp
+++ b/clim/text-formatting.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: text-formatting.lisp,v 1.12 93/03/04 19:00:14 colin Exp $
+;; $fiHeader: text-formatting.lisp,v 1.13 1993/07/27 01:41:30 colin Exp $
 
 (in-package :clim-internals)
 
@@ -243,8 +243,8 @@
 				      :indentation indentation)
 	       (with-new-output-record (stream)
 		 (funcall continuation stream))))))
-    (multiple-value-bind (x y) (output-record-position indenting-record)
-      (output-record-set-position indenting-record (+ x indentation) y))
+    (multiple-value-bind (x y) (output-record-start-cursor-position indenting-record)
+      (output-record-set-start-cursor-position indenting-record (+ x indentation) y))
     (tree-recompute-extent indenting-record)
     (replay indenting-record stream)
     (when move-cursor
diff --git a/clim/text-recording.lisp b/clim/text-recording.lisp
index f5a8d8b1f426e5c0b18cdee95afd62fa7d4df83b..5b7002ae0fe1966231dd8aab23e4f3dda618f5bd 100644
--- a/clim/text-recording.lisp
+++ b/clim/text-recording.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: text-recording.lisp,v 1.17 93/05/05 01:39:01 cer Exp $
+;; $fiHeader: text-recording.lisp,v 1.18 1993/07/27 01:41:38 colin Exp $
 
 (in-package :clim-internals)
 
@@ -212,13 +212,9 @@
   (let ((parent (output-record-parent record)))
     (if (not (null parent))
 	(with-bounding-rectangle* (old-left old-top old-right old-bottom) record
-	  (multiple-value-bind (xoff yoff)
-	      (convert-from-descendant-to-ancestor-coordinates record parent)
-	    (declare (type coordinate xoff yoff))
-	    (translate-coordinates xoff yoff old-left old-top old-right old-bottom)
-	    (call-next-method)
-	    (recompute-extent-for-changed-child parent record
-						old-left old-top old-right old-bottom)))
+	  (call-next-method)
+	  (recompute-extent-for-changed-child parent record
+					      old-left old-top old-right old-bottom))
 	(call-next-method))))
 
 (defmethod add-string-output-to-text-record ((record standard-text-output-record)
diff --git a/demo/demo-driver.lisp b/demo/demo-driver.lisp
index 7c8e1e06c20a87d51ce836170dacb039aee711c2..96f4f8b5e4703f53f75995d53fd9f61eeecd203b 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.27 1993/09/22 21:21:15 cer Exp $
+;; $fiHeader: demo-driver.lisp,v 1.28 1993/10/25 16:15:54 cer Exp $
 
 (in-package :clim-demo)
 
@@ -18,8 +18,7 @@
   (let ((do-name (clim-utils:fintern "~A-~A" 'do class)))
     `(let ((demo (make-instance 'demo 
 		   :name ,name :class ',class :initargs ',initargs)))
-       (clim-utils:push-unique demo
-	 *demos* :test #'string-equal :key #'demo-name)
+       (clim-utils:push-unique demo *demos* :key #'demo-class)
        (defun ,do-name (&rest args)
 	 (apply #'run-demo demo args)))))
 
@@ -51,50 +50,44 @@
 
 (define-demo-driver-command (com-run-demo)
     ((demo 'demo :gesture :select))
-  (mp:process-run-function (demo-name demo) 
-			   #'run-demo demo
-			   :port (port *application-frame*)))
+  (run-demo demo :port (port *application-frame*)))
 
 (define-gesture-name :shift-select :pointer-button (:left :shift))
 
 (define-demo-driver-command (com-force-demo)
     ((demo 'demo :gesture :shift-select))
-  (mp:process-run-function (demo-name demo) 
-			   #'run-demo demo
-			   :port (port *application-frame*) :force t))
-
-(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))
-	 (*package* (find-package :clim-demo)))
-    (when (or force (null frame))
-      (setq frame (apply (if activity-p
-			     #'make-instance
-			   #'make-application-frame)
-			 (demo-class demo)
-			 :frame-manager (find-frame-manager :port port)
-			 (demo-initargs demo))))
-    (if entry
-	(setf (cdr entry) frame)
-      (push (cons port frame) (demo-frames demo)))
-    (if (slot-value frame 'clim-internals::top-level-process)
-	(unless activity-p
-	  (note-frame-deiconified (frame-manager frame) frame)
-	  (raise-frame frame))
-      (run-frame-top-level frame))))
-
+  (run-demo demo :port (port *application-frame*) :force t))
+
+(defun run-demo (demo &key (port (find-port)) force (background t))
+  (flet ((do-it ()
+	   (let* ((entry (assoc port (demo-frames demo)))
+		  (frame (cdr entry))
+		  (activity-p (subtypep (demo-class demo) 'activity)))
+	     (when (or force (null frame))
+	       (setq frame (apply (if activity-p
+				      #'make-instance
+				    #'make-application-frame)
+				  (demo-class demo)
+				  :frame-manager (find-frame-manager :port port)
+				  (demo-initargs demo))))
+	     (if entry
+		 (setf (cdr entry) frame)
+	       (push (cons port frame) (demo-frames demo)))
+	     (if (slot-value frame 'clim-internals::top-level-process)
+		 (unless activity-p
+		   (note-frame-deiconified (frame-manager frame) frame)
+		   (raise-frame frame))
+	       (run-frame-top-level frame)))))
+    (if background 
+	(mp:process-run-function 
+	 `(:name ,(demo-name demo)
+	   :initial-bindings ((*package* . ',*package*)))
+	 #'do-it)
+      (do-it))))
+	
 (let ((demo (make-instance 'demo
 	      :name "Demo Driver" :class 'demo-driver
 	      :initargs '(:left 0 :top 0))))
   (defun start-demo (&rest args)
     (apply #'run-demo demo args)))
 
-
-#+Genera
-(cp:define-command (si:com-demonstrate-clim
-		     :name "Demonstrate CLIM"
-		     :command-table "Demonstration"
-		     :provide-output-destination-keyword nil)
-    ()
-  (start-demo))
diff --git a/demo/graphics-editor.lisp b/demo/graphics-editor.lisp
index e4c2979d78af78fff190ff9d12be7ff3b060e93b..af8917e8a07e2badafe6a9eb27e6966c1e48efe8 100644
--- a/demo/graphics-editor.lisp
+++ b/demo/graphics-editor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-GRAPHICS-EDITOR; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graphics-editor.lisp,v 1.21 1993/06/02 18:41:24 cer Exp $
+;; $fiHeader: graphics-editor.lisp,v 1.22 1993/09/17 00:20:35 colin Exp $
 
 (in-package :clim-graphics-editor)
 
@@ -273,7 +273,8 @@
 	     :incremental-redisplay t
 	     :display-after-commands t
 	     :display-function 'display-objects
-	     :scroll-bars :both)
+	     :scroll-bars :both
+	     :initial-cursor-visibility nil)
     (horizontal-options :accept-values
 			:min-height :compute :height :compute :max-height :compute
 			:display-function
diff --git a/silica/db-scroll.lisp b/silica/db-scroll.lisp
index 2a96771288d9383d9949658c813e51898abc2f10..940992bac01f96a789894e3dd81afcdf894e9fb3 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.48 1993/08/12 16:04:10 cer Exp $
+;; $fiHeader: db-scroll.lisp,v 1.49 1993/10/25 16:16:05 cer Exp $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright(c) 1991, 1992 International Lisp Associates.
@@ -258,7 +258,7 @@
 			    region)
 		  (repaint-sheet sheet region)))))
 	  (let ((frame (pane-frame sheet)))
-	    (when (and (/= left x) (/= top y) frame)
+	    (when frame
 	      (note-viewport-position-changed frame sheet x y))))))))
 
 (defmethod note-viewport-position-changed (frame pane x y)
diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp
index 7a1c9d67b3a63a840ef2e4d83bee06c8bf9c644c..0de18d63f18b2bd9a4bd3e92d286d94de52a4d7f 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.60 1993/09/17 19:07:01 cer Exp $
+;; $fiHeader: ol-gadgets.lisp,v 1.61 1993/10/25 16:16:36 cer Exp $
 
 
 (in-package :xm-silica)
@@ -404,7 +404,7 @@
 			     (apply #'make-instance 'xt::static-text
 					    :parent parent
 					    :string (ecase (command-menu-item-value item)
-						      ((nil :divider) " ")
+						      ((nil :line) " ")
 						      (:label menu))
 					    (compute-options item))))
 			  (:function
diff --git a/tk-silica/xm-frames.lisp b/tk-silica/xm-frames.lisp
index 8245b929e60db489559a02e2e32d69cd313ff84d..6f4ea1dd3f9011e0a33a9f06c026185aa4fd0706 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.62 1993/09/17 19:07:07 cer Exp $
+;; $fiHeader: xm-frames.lisp,v 1.63 1993/10/25 16:16:39 cer Exp $
 
 (in-package :xm-silica)
 
@@ -227,7 +227,7 @@
 				     :label-string menu
 				     :parent parent
 				     options))
-			     ((nil :divider)
+			     ((nil :line)
 			      (apply #'make-instance 'tk::xm-separator
 				     :parent parent
 				     options))))
@@ -559,10 +559,10 @@
 					   (if stream
 					       (frame-shell (pane-frame stream))
 					     (frame-shell *application-frame*)))
-				 :name "Working"
 				 :dialog-title "Progress Note"
+				 :name :progress-note
 				 :resize-policy :grow
-				 :message-string 
+				 :message-string
 				 (format nil "~A" (progress-note-name note)))))
       (multiple-value-bind
 	  (ok-button cancel-button help-button separator)
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index 8df4c59d3008e571d10b9315a3315cae0d80becd..553ecc2321c16b8e94e1e620beb41b4ec242003b 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.82 1993/09/17 19:07:10 cer Exp $
+;; $fiHeader: xm-gadgets.lisp,v 1.83 1993/10/25 16:16:42 cer Exp $
 
 (in-package :xm-silica)
 
@@ -492,31 +492,30 @@
                                                      (parent t)
                                                      (sheet top-level-sheet))
 
-  (cond 
-   ;;--- hack alert
-   ;; Seems that we need to use a bulletin board so that everything
-   ;; comes up in the right place.
-   ((popup-frame-p sheet)
-    (values 'tk::xm-bulletin-board
-	    (list :margin-width 0 :margin-height 0
-		  ;; We specify NIL for accelerators otherwise the
-		  ;; bulletin board messes with the event handling of
-		  ;; its drawing area children
-		  :accelerators nil
-		  ;; Prevents buttons from deactivating dialog
-		  :dialog-style :primary-application-modal
-		  :auto-unmanage nil
-		  :resize-policy :none
-		  :name (if (pane-frame sheet)
-			    (string (frame-name (pane-frame sheet)))
-			    "a CLIM pop-up"))))
-   (t
-    (values 'tk::xm-my-drawing-area 
-            (list :resize-policy :none
-                  :name (if (pane-frame sheet)
-                            (string (frame-name (pane-frame sheet)))
-                            "a CLIM sheet")
-                  :margin-width 0 :margin-height 0)))))
+  (let* ((frame (pane-frame sheet))
+	 (name (and frame
+		    (frame-name frame))))
+    (cond 
+     ;;--- hack alert
+     ;; Seems that we need to use a bulletin board so that everything
+     ;; comes up in the right place.
+     ((popup-frame-p sheet)
+      (values 'tk::xm-bulletin-board
+	      (list :margin-width 0 :margin-height 0
+		    ;; We specify NIL for accelerators otherwise the
+		    ;; bulletin board messes with the event handling of
+		    ;; its drawing area children
+		    :accelerators nil
+		    ;; Prevents buttons from deactivating dialog
+		    :dialog-style :primary-application-modal
+		    :auto-unmanage nil
+		    :resize-policy :none
+		    :name name)))
+     (t
+      (values 'tk::xm-my-drawing-area 
+	      (list :resize-policy :none
+		    :name name
+		    :margin-width 0 :margin-height 0))))))
 
 ;;;;;;;;;;;;;;;;
 
@@ -1251,7 +1250,7 @@
 				       '(:exit
 					 :abort
 					 :help))
-                                      (name title))
+                                      (name :notify-user))
   (let ((dialog (apply #'make-instance (ecase style
 					 (:inform 'tk::xm-information-dialog)
 					 (:error 'tk::xm-error-dialog)
@@ -1394,7 +1393,7 @@
 				  directory-list-label
 				  file-list-label
 				  (exit-boxes '(:exit :abort :help))
-				  (name title)
+				  (name :select-file)
 				  directory
 				  pattern
 				  text-style)
diff --git a/tk-silica/xt-gadgets.lisp b/tk-silica/xt-gadgets.lisp
index 4aff18eca4189754ccfc49393fb7312cb4742012..62ea30b37854961b365771f8088c91627a033372 100644
--- a/tk-silica/xt-gadgets.lisp
+++ b/tk-silica/xt-gadgets.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-gadgets.lisp,v 1.37 1993/07/30 23:58:39 colin Exp $
+;; $fiHeader: xt-gadgets.lisp,v 1.38 1993/09/07 21:47:17 colin Exp $
 
 (in-package :xm-silica)
 
@@ -51,7 +51,7 @@
 	      (progn
 		(when (and name 
 			   (not (getf initargs :name)))
-		  (setf (getf initargs :name) (string name)))
+		  (setf (getf initargs :name) name))
 		initargs)))))
 
 ;; Background/foreground/text-style mixin
@@ -156,6 +156,21 @@
 	  (make-translation-transformation  x y))
       +identity-transformation+)))
 
+;;; this needs to return region in co-ordinate system of parent.
+;;; However CLIM's idea of parent is the graft, while Xt's is the
+;;; shell. So we have to use the x and y from the shell to make things
+;;; consistent (cim)
+
+(defmethod mirror-region* ((port xt-port) (sheet xt-top-level-sheet))
+  (let ((mirror (sheet-mirror sheet)))
+    (when mirror
+      (multiple-value-bind (x y)
+	  (get-values (tk::widget-parent mirror) :x :y)
+	(multiple-value-bind (width height)
+	    (get-values mirror :width :height)
+	  (values (coordinate x) (coordinate y) 
+		  (coordinate (+ x width)) (coordinate (+ y height))))))))
+
 (defmethod top-level-sheet-accelerator-gestures ((sheet top-level-sheet)) nil)
 
 (defmethod sheet-disown-child :after ((sheet xt-top-level-sheet) (child basic-sheet))
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index cd1e9b478677fdee919c177a093cebc74121696b..cb242b9b59544db7afa6be7bc742c345cc962fc8 100644
--- a/tk-silica/xt-silica.lisp
+++ b/tk-silica/xt-silica.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-silica.lisp,v 1.88 1993/09/07 21:47:28 colin Exp $
+;; $fiHeader: xt-silica.lisp,v 1.90 1993/09/22 18:26:47 layer Exp $
 
 (in-package :xm-silica)
 
@@ -652,7 +652,7 @@
 	    (find-shell-class-and-initargs port sheet)
 	  (let ((frame (pane-frame sheet)))
 	    (when frame
-	      (setf (getf initargs :name) (string (frame-name frame))
+	      (setf (getf initargs :name) (frame-name frame)
 		    (getf initargs :title) (frame-pretty-name
 					    frame)))
 	    (let ((shell (apply #'make-instance class 
@@ -1221,11 +1221,9 @@
     ((port xt-port) (parent t) (sheet mirrored-sheet-mixin))
   (multiple-value-bind (class initargs)
       (find-widget-class-and-initargs-for-sheet port parent sheet)
-    (let ((class-name 
-	   (tk::widget-class-name (tk::class-handle (find-class class)))))
-      (values (or (getf initargs :name)
-		  (string-downcase class-name :start 0 :end 1))
-	      class-name))))
+    (values (tk::tkify-lisp-name (or (getf initargs :name)
+				     class))
+	    (tk::tkify-lisp-name class :class t))))
 
 (defmethod find-widget-name-and-class
     ((port xt-port) (parent t) (sheet basic-sheet))
@@ -1239,7 +1237,7 @@
 (defmethod get-sheet-resources ((port xt-port) sheet)
   (let ((parent-widget (sheet-mirror (sheet-parent sheet))))
     (multiple-value-bind (names classes)
-	(xt::widget-resource-name-and-class parent-widget)
+	(tk::widget-resource-name-and-class parent-widget)
       (multiple-value-bind (name class)
 	  (find-widget-name-and-class port parent-widget sheet)
 	(when name
diff --git a/tk/convenience.lisp b/tk/convenience.lisp
index 79f255f330d4988e54869f4ae1e8a3a9b41e3e69..b54d77b72ac2f00dab567a44ac2308896fc50fbb 100644
--- a/tk/convenience.lisp
+++ b/tk/convenience.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: convenience.lisp,v 1.14 93/03/19 09:46:48 cer Exp $
+;; $fiHeader: convenience.lisp,v 1.15 1993/07/27 01:52:36 colin Exp $
 
 (in-package :tk)
 
@@ -40,11 +40,8 @@
 	 (defclass ,class ,superclasses
 	   ()
 	   (:metaclass xt-class))
-	 (defmethod make-widget ((w ,class) &rest args &key (managed t)
-					    (name "") 
-					    parent &allow-other-keys)
-	   (remf args :name)
-	   (remf args :parent)
+	 (defmethod make-widget ((w ,class) name parent &rest args
+				 &key (managed t) &allow-other-keys)
 	   (remf args :managed)
 	   (let* ((arglist (make-arglist-for-class
 			    (find-class ',class)
diff --git a/tk/make-classes.lisp b/tk/make-classes.lisp
index ac3829bf341d39a50cc720e30e132e3ce8d95238..a18da4dc81659ea1343b569a9e3301d7a01ecc13 100644
--- a/tk/make-classes.lisp
+++ b/tk/make-classes.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: make-classes.lisp,v 1.34 1993/05/13 16:24:36 cer Exp $
+;; $fiHeader: make-classes.lisp,v 1.36 1993/07/29 20:51:56 layer Exp $
 
 (in-package :tk)
 
@@ -269,7 +269,14 @@
 	 package)
       string)))
 
-
+(defun tkify-lisp-name (name &key class)
+  (if (stringp name)
+      name
+    (let ((tk-name (remove #\- (string-capitalize (string name)))))
+      (if class
+	  tk-name
+	(string-downcase tk-name :start 0 :end 1)))))
+	  
 (defun-c-callable toolkit-error-handler ((message :unsigned-long))
   (let ((*error-output* excl:*initial-terminal-io*))
     (error "Xt: ~a" (char*-to-string message))))
diff --git a/tk/make-widget.lisp b/tk/make-widget.lisp
index 1ece2ad69d9047d46168052066f9056082cdca6f..6bb61bb8ffa938c52cbe2536366ac287de218548 100644
--- a/tk/make-widget.lisp
+++ b/tk/make-widget.lisp
@@ -20,31 +20,27 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: make-widget.lisp,v 1.8 1993/07/27 01:53:14 colin Exp $
+;; $fiHeader: make-widget.lisp,v 1.9 1993/09/17 19:06:44 cer Exp $
 
 (in-package :tk)
 
-(defgeneric make-widget (widget &key)
+(defgeneric make-widget (widget name parent &key)
   ;;; returns the handle of a widget
   )
 
-(defmethod make-widget ((w core) &rest args &key parent (managed t) (name "") &allow-other-keys)
+(defmethod make-widget ((w core) name parent &rest args &key (managed t)
+			&allow-other-keys)
   (remf args :managed)
-  (remf args :name)
-  (remf args :parent)
   (let ((class (class-of w)))
     (if managed
 	(apply #'create-managed-widget name class parent args)
       (apply #'create-widget name class parent args))))
 
-(defmethod make-widget ((w shell) &rest args &key parent (name "") &allow-other-keys)
+(defmethod make-widget ((w shell) name parent &rest args)
   (declare (ignore args parent name))
   (error "shells not made this way"))
 
-
-(defmethod make-widget ((w top-level-shell) &rest args &key parent (name "") &allow-other-keys)
-  (remf args :parent)
-  (remf args :name)
+(defmethod make-widget ((w top-level-shell) name parent &rest args)
   (apply #'create-popup-shell name (class-of w) parent args))
 
 
diff --git a/tk/ol-init.lisp b/tk/ol-init.lisp
index 336a2d9bd2bb081d5602d9f04ca4bda6043b660a..c2884685e921c6ee78922e6f817928a81983f561 100644
--- a/tk/ol-init.lisp
+++ b/tk/ol-init.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-init.lisp,v 1.17 1993/06/04 16:07:00 cer Exp $
+;; $fiHeader: ol-init.lisp,v 1.18 1993/07/27 01:53:36 colin Exp $
 
 (in-package :tk)
 
@@ -64,11 +64,9 @@
        *openlook-classes*)
   (setq *ol-done* t))
 
-(defmethod make-widget ((w event) 
-			&rest args &key parent (managed t) (name "") &allow-other-keys)
+(defmethod make-widget ((w event) name parent &rest args &key (managed t)
+			&allow-other-keys)
   (remf args :managed)
-  (remf args :name)
-  (remf args :parent)
   (let ((class (class-of w)))
     (if managed
 	(apply #'create-managed-widget name class parent args)
diff --git a/tk/ol-widgets.lisp b/tk/ol-widgets.lisp
index 54cdb10bb342865afd410bd4a848a47d34773243..f23917d3423e9d14e49789e2ac40fb2bf0357e3f 100644
--- a/tk/ol-widgets.lisp
+++ b/tk/ol-widgets.lisp
@@ -20,20 +20,16 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-widgets.lisp,v 1.5 1993/06/02 18:42:15 cer Exp $
+;; $fiHeader: ol-widgets.lisp,v 1.6 1993/07/30 23:58:23 colin Exp $
 
 (in-package :xt)
 
 
-(defmethod make-widget ((w menu-shell) &rest args &key parent (name "") &allow-other-keys)
-  (remf args :parent)
-  (remf args :name)
+(defmethod make-widget ((w menu-shell) name parent &rest args)
   (apply #'create-popup-shell name (class-of w) parent args))
 
 
-(defmethod make-widget ((w transient-shell) &rest args &key parent (name "") &allow-other-keys)
-  (remf args :parent)
-  (remf args :name)
+(defmethod make-widget ((w transient-shell) name parent &rest args)
   (apply #'create-popup-shell name (class-of w) parent args))
 
 
diff --git a/tk/widget.lisp b/tk/widget.lisp
index d0997495571e3e434c7e72cd3341be0dacf9b3fb..c2ce19984b1d55fe76c16e2811408f969e827fe0 100644
--- a/tk/widget.lisp
+++ b/tk/widget.lisp
@@ -20,16 +20,16 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: widget.lisp,v 1.33 1993/09/17 19:06:47 cer Exp $
+;; $fiHeader: widget.lisp,v 1.34 1993/10/25 16:16:29 cer Exp $
 
 (in-package :tk)
 
 (defun app-create-shell (&rest args
-			       &key (application-name "clim")
-			       (application-class "Clim")
-			       (widget-class (error "Class not specified"))
-			       (display (error "Display not specified"))
-			       &allow-other-keys)
+			 &key (application-name "clim")
+			      (application-class "Clim")
+			      (widget-class (error "Class not specified"))
+			      (display (error "Display not specified"))
+			 &allow-other-keys)
   (let* ((class (find-class widget-class))
 	 (handle (class-handle class))
 	 (arglist (make-arglist-for-class class nil args)))
@@ -156,7 +156,7 @@
 (defmethod initialize-instance :after ((w xt-root-class) 
 				       &rest args 
 				       &key foreign-address 
-				       parent display
+					    name parent display
 				       &allow-other-keys)
   (when (or display parent)
     (setf (slot-value w 'display)
@@ -167,13 +167,12 @@
      w
      (progn
        (remf args :foreign-address)
-       (unless (getf args :name)
-	 (setf (getf args :name)
-	   (string-downcase 
-	    (tk::widget-class-name (tk::class-handle (class-of w)))
-	    :start 0 :end 1)))
+       (remf args :name)
+       (remf args :parent)
+       (unless name
+	 (setq name (class-name (class-of w))))
        (setf (foreign-pointer-address w)
-	 (apply #'make-widget w args))))))
+	 (apply #'make-widget w (tkify-lisp-name name) parent args))))))
 
 
 
diff --git a/tk/xlib.lisp b/tk/xlib.lisp
index b6924c5def9ddddcb4a207c5cc378f6fdb1acc5e..619638729787ccef1a476f67479174e79c73c266 100644
--- a/tk/xlib.lisp
+++ b/tk/xlib.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xlib.lisp,v 1.48 1993/08/12 16:04:48 cer Exp $
+;; $fiHeader: xlib.lisp,v 1.49 1993/09/17 19:06:49 cer Exp $
 
 (in-package :tk)
 
@@ -747,3 +747,45 @@
     (1 :gray-scale)
     (3 :pseudo-color)
     (5 :direct-color)))
+
+;;; limited cut buffer support
+
+(defun store-cut-buffer (display string)
+  ;; clear any existing selection
+  (x11:xsetselectionowner
+   display
+   x11:xa-primary
+   x11:none
+   x11:currenttime)
+  (x11:xchangeproperty
+   display
+   (x11:xdefaultrootwindow display)
+   x11:xa-cut-buffer0
+   x11:xa-string
+   8
+   x11:propmodereplace
+   string
+   (length string)))
+
+(defun get-cut-buffer (display)
+  (let ((string (make-string 1024)))
+    (with-ref-par
+	((actual-type 0)
+	 (actual-format 0)
+	 (nitems 0)
+	 (bytes-after 0)
+	 (prop 0))
+      (x11:xgetwindowproperty 
+       display
+       (x11:xdefaultrootwindow display)
+       x11:xa-cut-buffer0
+       0
+       256
+       0
+       x11:anypropertytype
+       actual-type
+       actual-format
+       nitems
+       bytes-after
+       prop)
+      (char*-to-string (aref prop 0)))))
diff --git a/tk/xm-widgets.lisp b/tk/xm-widgets.lisp
index 645550f07bcd44ede862736d6ba1d26bdcfad047..99e989f28143bc52f731617ff85672d39b67476f 100644
--- a/tk/xm-widgets.lisp
+++ b/tk/xm-widgets.lisp
@@ -20,34 +20,26 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-widgets.lisp,v 1.15 1993/07/27 01:54:10 colin Exp $
+;; $fiHeader: xm-widgets.lisp,v 1.16 1993/08/12 16:04:54 cer Exp $
 
 (in-package :tk)
 
-(defmethod make-widget ((w xm-gadget) 
-			&rest args &key parent (managed t) (name "") &allow-other-keys)
+(defmethod make-widget ((w xm-gadget) name parent &rest args &key (managed t)
+			&allow-other-keys)
   (remf args :managed)
-  (remf args :name)
-  (remf args :parent)
   (let ((class (class-of w)))
     (if managed
 	(apply #'create-managed-widget name class parent args)
       (apply #'create-widget name class parent args))))
 
-(defmethod make-widget ((w xm-dialog-shell) &rest args &key parent (name "") &allow-other-keys)
-  (remf args :parent)
-  (remf args :name)
+(defmethod make-widget ((w xm-dialog-shell) name parent &rest args)
   (apply #'create-popup-shell name (class-of w) parent args))
 
 #+ignore
-(defmethod make-widget ((w override-shell) &rest args &key parent (name "") &allow-other-keys)
-  (remf args :parent)
-  (remf args :name)
+(defmethod make-widget ((w override-shell) name parent &rest args)
   (apply #'create-popup-shell name (class-of w) parent args))
 
-(defmethod make-widget ((w xm-menu-shell) &rest args &key parent (name "") &allow-other-keys)
-  (remf args :parent)
-  (remf args :name)
+(defmethod make-widget ((w xm-menu-shell) name parent &rest args)
   (apply #'create-popup-shell name (class-of w) parent args))
 
 (tk::add-resource-to-class (find-class 'vendor-shell)