diff --git a/Makefile b/Makefile
index 1107e75ab577291005a7c95c9585cb2370c29d6c..97bac99b909d042afa6eaf9388e04b9aee525a49 100644
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,18 @@
-DIRS= . 
+SOMEDIRS=utils silica clim ws xm-silica
+DIRS=$(SOMEDIRS) xlib tk
+DEVICE=/dev/null
+CL=/usr/composer2/composer2
+
+default: compile
+
+compile : FRC
+	$(CL) < misc/go.cl
 
 clean : FRC
 	find $(DIRS)  -name "*.fasl" -exec $(RM) "{}" \;
 
 FRC :
+
+
+swm-tape:
+	tar cf $(DEVICE) `find misc $(SOMEDIRS) '(' -name "*.cl" -o -name "*.lisp" ')' -print`
diff --git a/clim/clim-defs.lisp b/clim/clim-defs.lisp
index df1e2a2de7d507f4eb4118c774771c40e7d15627..052fe5de8f35f74411f66f077801e8c9f4b60bf4 100644
--- a/clim/clim-defs.lisp
+++ b/clim/clim-defs.lisp
@@ -379,3 +379,21 @@
 	     (push `(setf ,(first pts)  (the fixnum (+ ,(first pts)  ,x-delta))) forms)
 	     (push `(setf ,(second pts) (the fixnum (+ ,(second pts) ,y-delta))) forms))
 	   (nreverse forms)))))
+
+(defmacro with-scaling ((medium sx &optional (sy nil sy-p)) &body body)
+  `(with-drawing-options (,medium
+			  :transformation (let* ((scale-x ,sx)
+						 (scale-y ,(if sy-p sy 'scale-x)))
+					    (make-scaling-transformation scale-x scale-y)))
+     ,@body))
+
+(defmacro with-translation ((medium dx dy) &body body)
+  `(with-drawing-options (,medium
+			  :transformation (make-translation-transformation ,dx ,dy))
+     ,@body))
+
+(defmacro with-rotation ((medium angle &optional (origin nil origin-p)) &body body)
+  `(with-drawing-options (,medium
+			  :transformation (make-rotation-transformation ,angle
+									,@(if origin-p `(,origin) nil)))
+     ,@body))
diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp
index b796dce336ef677129208f1851f8663501a3467c..cb2edb4873d6bf04981b02b4e419949092676a2d 100644
--- a/clim/db-stream.lisp
+++ b/clim/db-stream.lisp
@@ -82,7 +82,7 @@
 				 )
 	  ()
   (:default-initargs :medium t 
-		     :max-width +fill+ :min-width +fill+ :max-height +fill+ :min-height +fill+))
+		     :max-width +fill+ :min-width 0 :max-height +fill+ :min-height 0))
 
 
 
@@ -142,13 +142,13 @@
 ;;; to represent the size of the contents, but may be stretched to fill the
 ;;; available viewport space.
 
-(defmethod change-space-req :around ((pane extended-stream-pane) &rest keys &key hs vs)
+(defmethod silica::change-space-req :around ((pane extended-stream-pane) &rest keys &key width height)
   (declare (dynamic-extent keys))
-  ;; Assume always called with hs vs
+  ;; Assume always called with width height
   (multiple-value-bind (history-width history-height)
       (bounding-rectangle-size (output-recording-stream-output-record pane))
     ;; Don't ever shrink down smaller than our contents.
-    (apply #'call-next-method pane :hs (max hs history-width) :vs (max vs history-height) keys)))
+    (apply #'call-next-method pane :width (max width history-width) :height (max height history-height) keys)))
 
 (defclass basic-clim-interactor (extended-stream-pane) 
 	  ((display-function :initarg :display-function
diff --git a/clim/frames.lisp b/clim/frames.lisp
index 8c9a736336a51f3ca51b823f219c46b90c11c404..0cfb6e9f9e0ff523cd5a6023bf9d2ff916b88aa9 100644
--- a/clim/frames.lisp
+++ b/clim/frames.lisp
@@ -38,8 +38,8 @@
    (panes :initarg :panes :accessor frame-panes)
    (top-level-sheet :accessor frame-top-level-sheet :initform nil)
    (shell :accessor frame-shell)
-   (state :initform :disowned :accessor frame-state 
-	  :type (member :disowned :enable :disabled :shrunk))
+   (state :initform :disabled :accessor frame-state 
+	  :type (member :disabled :enable :disabled :shrunk))
    (command-table :initarg :command-table 
 		  :initform (find-command-table 'user-command-table)
 		  :accessor frame-command-table)
@@ -54,6 +54,9 @@
 (defmethod frame-name ((frame application-frame))
   (format nil "~A" (type-of frame)))
 
+(defmethod frame-pretty-name ((frame application-frame))
+  (frame-name frame))
+
 (defvar *frame-managers* nil)
 
 (defun find-frame-manager (&rest options)
@@ -104,10 +107,8 @@
 	  ,@(and command-table
 		 `(:command-table (clim-internals::find-command-table ',(car command-table))))))
        ,@(when command-table
-	   `((define-command-table ,(first
-					  command-table)
-					 ,@(and (cdr command-table) 
-						`(:inherit-from ,(cdr command-table))))))
+	   `((define-command-table ,(first command-table)
+					 ,@(cdr command-table))))
        ,@(when command-definer
 	   (compute-command-definer-code name command-table))
        ,@(compute-generate-panes-code name pane))))
@@ -134,9 +135,14 @@
 	 `((defmethod generate-panes ((,f ,name) (,fm frame-manager))
 	     (let ((*application-frame* ,f))
 	       (setf (frame-panes ,f)
-		 (with-look-and-feel-realization 
-		     (,fm ,f)
-		   ,code))))))))
+		 (frame-wrapper
+		  ,f ,fm
+		  (with-look-and-feel-realization 
+		      (,fm ,f)
+		    ,code)))))))))
+
+(defmethod frame-wrapper ((frame t) (framem t) pane)
+  pane)
 
 (defmacro with-look-and-feel-realization ((realizer frame) &rest forms)
   `(macrolet ((silica::realize-pane (&rest foo)
@@ -164,7 +170,11 @@
     (let ((sr (compose-space (frame-panes frame))))
       (setq width (silica::space-req-width sr)
 	    height (silica::space-req-height sr))))
-  (allocate-space (frame-panes frame) width height))
+  (allocate-space (frame-panes frame) width height)
+  #+shouldwebedoingthiskindofthing?
+  (when (frame-top-level-sheet frame)
+    (silica::resize-sheet* (frame-top-level-sheet frame)
+			   width height)))
 
 (defun make-application-frame (class &rest options &key enable &allow-other-keys)
   (with-rem-keywords (options options '(:enable))
diff --git a/clim/menus.lisp b/clim/menus.lisp
index a45b0c3267b887eaa14545bdfcbda3f0196d4fdc..ed883b0db3901b52ad0a2bbde48ae5d14c96eddb 100644
--- a/clim/menus.lisp
+++ b/clim/menus.lisp
@@ -1,58 +1,31 @@
-;;; -*- Mode: LISP; Syntax: Common-lisp; Package: CLIM-INTERNALS; Base: 10 -*-
 
-(in-package "CLIM-INTERNALS")
+(in-package :clim-internals)
 
 "Copyright (c) 1988, 1989, 1990 International Lisp Associates.  All rights reserved."
 
 (defparameter *default-menu-margin-components* '((margin-borders :thickness 2)
 						 (margin-white-borders :thickness 2)))
 
-#-Silica
-(defresource menu (associated-window root)
-  :constructor (open-window-stream :parent root	;"random" size
-				   :left 100 :top 100 :width 1000 :height 500
-				   ;; :margin-components *default-menu-margin-components*
-				   :scroll-bars ':vertical
-				   :save-under T
-				   )
-  :deinitializer (window-clear menu)
-  ;; We used to have an initializer that set record-p, cleared the window, and set
-  ;; the size.  Record-p is unnecessary because we explicitly bind it below
-  ;; when drawing the menu contents.  (Also, it should always be T anyway.)
-  ;; Clearing the window is unnecessary because it's done in the deinitializer.
-  ;; Setting the size is also unnecessary.  Any application that's formatting
-  ;; into a menu is required to use with-end-of-line-action and with-end-of-page-action
-  ;; or set the size first itself.
-  :initializer (initialize-menu menu associated-window)
-  :matcher (eql (window-parent menu) root)
-  )
+(define-application-frame menu-frame ()
+  (menu)
+  (:pane
+   (with-slots (menu) *application-frame*
+     (silica::scrolling ()
+			(setq menu (silica::realize-pane 'extended-stream-pane
+							 :initial-cursor-visibility nil
+							 ))))))
 
-#+Silica
 (defun get-menu (&key server-path)
-  (let ((framem (find-frame-manager :server-path server-path))
-	(frame (make-frame 'frame :plain t :no-message t :save-under T))
-	(menu nil))
-    (ws:with-look-and-feel-realization (framem frame)
-      (setf (frame-pane frame)
-	    (bordering ()
-	     (spacing (:space  2)
-		 (vscrolling (:hs+
-			      +fill+ :vs+ +fill+ :hs 400 :vs 300
-			      :subtransformationp t )
-		   (setq menu (make-pane 'extended-stream-pane
-					 :initial-cursor-visibility nil
-					 )))))))
-    (adopt-frame framem frame)
-    ;; (enable-frame frame)
-    menu))
+  (let ((frame (make-application-frame 'menu-frame)))
+    (slot-value frame 'menu)))
 
 ;;; Still requires some thought, but at least this works in an environment
 ;;; with multiple ports.
-#+Silica
-(defresource menu (associated-window root)
+
+(clim-utils::defresource menu (associated-window root)
 	     :constructor (let* ((port (if (null root) (find-port) ; Horrible kluge #2.
 					 (port root)))
-		      (server-path (port-server-path port)))
+		      (server-path (silica::port-server-path port)))
 		 (get-menu :server-path server-path))
   :deinitializer (window-clear menu)
   ;; We used to have an initializer that set record-p, cleared the window, and set
@@ -72,106 +45,49 @@
 ;;; needs to be set to an X window, either one associated with the associated window
 ;;; or to one associated with window.  In other implementations, this can do nothing.
 ;;; --- What class for this default method?
-#+Silica
-(defmethod initialize-menu ((port w::basic-port) window associated-window)
-  (declare (ignore window associated-window))
-  )
 
-#-Silica 
-;; no window-mixin
-(defmethod initialize-menu ((menu window-mixin) associated-window)
-  (declare (ignore associated-window))
+(defmethod initialize-menu ((port port) window associated-window)
+  (declare (ignore window associated-window))
   )
 
 ;;; For now, MENU-CHOOSE requires that you pass in a parent.
 (defmacro with-menu ((menu associated-window) &body body)
   (let ((ass-win (gensymbol 'associated-window)))
     `(let ((,ass-win ,associated-window))			;once-only
-       (using-resource (,menu menu (window-top-level-window ,ass-win) (window-root ,ass-win))
+       (clim-utils::using-resource (,menu menu (window-top-level-window ,ass-win) (window-root ,ass-win))
 	 ,@body))))
 
-#-Silica
-(defun size-menu-appropriately (menu
-				 &key (right-margin 10) (bottom-margin 10))
-  (with-slots (output-record parent) menu
-    (multiple-value-bind (left top right bottom)
-	(entity-edges output-record)
-      (multiple-value-bind (label-width label-height)
-	  (window-label-size menu)
-	(multiple-value-bind (parent-width parent-height)
-	    (window-inside-size parent)
-	  (multiple-value-bind (lm tm rm bm)
-	      (host-window-margins menu)
-	    (entity-set-size 
-	      menu
-	      (min (+ (max label-width (- right left)) right-margin lm rm) parent-width)
-	      (min (+ (max label-height (- bottom top)) bottom-margin tm bm) parent-height)))))
-      (window-set-viewport-position menu left top)
-      ;; blech
-      (stream-clear-input menu))))
-
-#+Silica
+
+
+
 (defun size-menu-appropriately (menu &key (right-margin 10) (bottom-margin 10))
   (with-slots (output-record) menu
     (with-bounding-rectangle* (minx miny maxx maxy) output-record
       (let* ((graft (graft menu))
 	     (gw (bounding-rectangle-width (sheet-region graft)))
 	     (gh (bounding-rectangle-height (sheet-region graft)))
-	     ;; (vw (ws::pane-viewport menu))
+	     ;; (vw (pane-viewport menu))
 	     (width (min gw (+ (- maxx minx) right-margin)))
 	     (height (min gh (+ (- maxy miny) bottom-margin))))
 
-	(ws::change-space-req menu :hs width :vs height)
+	(silica::change-space-req menu :width width :height height)
 	;; --- Damn.  How do we get this to propagate the size change up
 	;; the tree so that the whole frame gets re-size to the pane?
 	;; For now, kludge it by setting the frame size directly.
 	;; Allow for scroll bar width
-	(ws::relayout-frame (pane-frame menu) (+ width 20) height)
-	;;(when vw (ws::change-space-req vw :hs width :vs height))
-	;;(resize-sheet* menu width height)
+	;; (layout-frame (silica::pane-frame menu) (+ width 20) (+ 20 height))
+	;; (when vw (change-space-req vw :hs width :vs height))
+	;; (resize-sheet* menu width height)
 
+	(silica::clear-space-req-caching-in-ancestors menu)
+	
 	;; --- RR needs to fix this at some point.
 	;; --- It has to do with the viewport having a bad scrolling transform
 	;; after a resize.
+	#+ignore
 	(setf (sheet-transformation (sheet-parent menu))
 	      (make-translation-transformation 
-	       0 0 :reuse (sheet-transformation (sheet-parent menu))))))))
-
-#+Silica
-(defun position-window-near-carefully (menu x y)
-  (let* ((frame (pane-frame menu))
-	 (frame-manager (frame-manager frame))
-	 (graft (graft frame-manager)))
-    ;; Make sure the menu will fit inside the graft.
-    (with-bounding-rectangle* (min-x min-y max-x max-y) (sheet-region graft)
-      (multiple-value-bind (width height) (bounding-rectangle-size (sheet-region menu))
-	(setf x (max min-x (min x (- max-x width))))
-	(setf y (max min-y (min y (- max-y height))))))
-    (move-frame frame x y)))
-
-#+Ignore ;; Old version
-(defun position-window-near-carefully (menu x y)
-  ;; --- no "carefully" for now
-  (let ((frame (pane-frame menu)))
-    (ws::move-frame frame x y)))
-
-#-Silica
-(defun position-window-near-carefully (window x y)
-  ;; unfortunately, the mouse-position is in window-parent coordinates
-  (multiple-value-bind (width height) (entity-size window)
-    (multiple-value-bind (parent-width parent-height)
-	(window-inside-size (window-parent window))
-      (let* ((left x)
-	     (top y)
-	     (right (+ left width))
-	     (bottom (+ top height)))
-	(when (> right parent-width)
-	  (setq left (- parent-width width)))
-	(when (> bottom parent-height)
-	  (setq top (- parent-height height)))
-	(entity-set-position 
-	  window
-	  (max 0 left) (max 0 top))))))
+	       0 0))))))
 
 ;;; item-list := (item*)
 ;;; item := object | (name :value object) | (object . value)
@@ -243,12 +159,12 @@
 ;;; What are reasonable defaults for CACHE, UNIQUE-ID, CACHE-VALUE, UNIQUE-ID-TEST, and
 ;;; CACHE-VALUE-TEST?
 (defun menu-choose (item-list
-		     &key associated-window default-item default-style
-		     (cache nil) (unique-id item-list) (cache-value item-list)
-		     (unique-id-test #'equal) (cache-value-test #'equal)
-		     label
-		     printer
-		     presentation-type)
+		    &key associated-window default-item default-style
+			 (cache nil) (unique-id item-list) (cache-value item-list)
+			 (unique-id-test #'equal) (cache-value-test #'equal)
+			 label
+			 printer
+			 presentation-type)
   #+Genera (declare (values value chosen-item gesture))
   (labels ((menu-choose (stream presentation-type)
 	     (draw-standard-menu stream presentation-type
@@ -263,26 +179,25 @@
 		   (t (print-menu-item item stream)))))
     (declare (dynamic-extent #'item-printer #'menu-choose))
     (with-menu (menu associated-window)
-      #-Silica (setf (window-label menu) label)
-      #+Silica (reset-frame (pane-frame menu) :title label)
+      (reset-frame (silica::pane-frame menu) :title label)
       (with-text-style (default-style menu)
 	(loop
 	  (multiple-value-bind (item gesture)
 	      (menu-choose-from-drawer 
-		menu 'menu-item
-		#'menu-choose
-		:unique-id unique-id
-		:unique-id-test unique-id-test
-		:cache-value cache-value
-		:cache-value-test cache-value-test
-		:cache cache))
-	  (cond ((menu-item-item-list item)
-		 ;; set the new item list then go back through the loop
-		 (setq item-list (menu-item-item-list item) default-item nil)
-		 (clear-output-history menu))
-		(t (return-from menu-choose (values (menu-item-value item)
-						    item
-						    gesture)))))))))
+	       menu 'menu-item
+	       #'menu-choose
+	       :unique-id unique-id
+	       :unique-id-test unique-id-test
+	       :cache-value cache-value
+	       :cache-value-test cache-value-test
+	       :cache cache)
+	    (cond ((menu-item-item-list item)
+		   ;; set the new item list then go back through the loop
+		   (setq item-list (menu-item-item-list item) default-item nil)
+		   (clear-output-history menu))
+		  (t (return-from menu-choose (values (menu-item-value item)
+						      item
+						      gesture))))))))))
 
 ;(defun draw-standard-menu (menu presentation-type item-list)
 ;  (dolist (item item-list)
@@ -302,7 +217,7 @@
       (let ((pres (with-output-as-presentation (:stream menu
 					    :object item
 					    :type presentation-type
-					    :single-box T)
+					    :single-box t)
 		(formatting-cell (menu)
 		  (funcall item-printer item menu)))))
 	(when (eql item default-item) (setf default-pres pres)))))
@@ -311,9 +226,7 @@
 (defun position-window-at-pointer (window &optional x y)
   (unless (and x y)
     (multiple-value-setq (x y)
-      #-Silica 
-      (stream-pointer-position-in-window-coordinates (window-parent window))
-      #+Silica
+
       (poll-pointer (graft window))))
   (position-window-near-carefully window x y))
   
@@ -329,7 +242,7 @@
 				     x-position y-position
 				     ;; for use by hierarchichal-menu-choose
 				     leave-menu-visible
-				     unique-id (cache-value T) cache
+				     unique-id (cache-value t) cache
 				     (unique-id-test #'equal) (cache-value-test #'eql)
 				     &aux default-presentation)
   ;; We could make the drawer a lexical closure, but that would then
@@ -356,19 +269,19 @@
   (size-menu-appropriately menu)
   (position-window-at-pointer menu x-position y-position)
   (unwind-protect
-      (with-simple-abort-restart ("Exit the menu")
+      (clim-utils::with-simple-abort-restart ("Exit the menu")
 	;;; --- Figure out later why this is necessary...
 	;;; it isn't now, 'cause we set the viewport in size-menu-appropriately
 	;;(window-set-viewport-position menu 0 0)
 	(window-expose menu)
 	(when default-presentation
 	  (multiple-value-bind (left top right bottom)
-	      (entity-edges default-presentation)
+	      (bounding-rectangle* default-presentation)
 	    (stream-set-pointer-position*
 	      menu (floor (+ left right) 2) (floor (+ top bottom) 2))))
 	;; Menus DON'T want a blinking cursor...
 	(with-cursor-visibility (nil menu)
-	  (with-input-context (type :override T)
+	  (with-input-context (type :override t)
 			      (object presentation-type gesture)
 	       (loop (read-gesture :stream menu)
 		     (beep))
@@ -486,8 +399,7 @@
 		   (t (print-menu-item item stream)))))
     (declare (dynamic-extent #'menu-choose #'item-printer))
     (with-menu (menu associated-window)
-      #-Silica (setf (window-label menu) label)
-      #+Silica (reset-frame (pane-frame menu) :title label)
+      (reset-frame (silica::pane-frame menu) :title label)
       (with-text-style (default-style menu)
 	(unwind-protect
 	    (multiple-value-bind (item gesture)
@@ -518,3 +430,45 @@
 				 item
 				 gesture)))))
 	  (window-set-visibility menu nil))))))
+
+;;; Weird shit
+
+(defun window-top-level-window (win) win)
+(defun window-root (win) win)
+
+
+(defun reset-frame (frame &rest ignore) nil)
+(defun poll-pointer (x) (values 500 500))
+
+(defmethod window-expose ((stream extended-stream-pane))
+  (setf (window-visibility stream) t))
+
+(defun window-set-visibility (window visibility)
+  (setf (window-visibility window) visibility))
+
+
+(defmethod (setf window-visibility) (nv (stream extended-stream-pane))
+  (if nv 
+      (enable-frame (silica::pane-frame stream))
+      (disable-frame (silica::pane-frame stream))))
+
+(defun entity-edges (x)
+  (bounding-rectangle* x))
+
+
+
+
+(defun position-window-near-carefully (menu x y)
+  #+ignore
+  (let* ((frame (silica::pane-frame menu))
+	 (frame-manager (frame-manager frame))
+	 (graft (graft frame-manager)))
+    ;; Make sure the menu will fit inside the graft.
+    (with-bounding-rectangle* (min-x min-y max-x max-y) (sheet-region graft)
+      (multiple-value-bind (width height) (bounding-rectangle-size (sheet-region menu))
+	(setf x (max min-x (min x (- max-x width))))
+	(setf y (max min-y (min y (- max-y height))))))
+    (move-frame frame x y)))
+
+(defmethod clim-internals::window-refresh (window)
+  (warn "What does this do???"))
diff --git a/clim/output-recording-protocol.lisp b/clim/output-recording-protocol.lisp
index 4aac8bdad18ede68098abf9bd0e04a22e9f7404d..257b810ce81a44d197e429a8ec4dbf50a110cbef 100644
--- a/clim/output-recording-protocol.lisp
+++ b/clim/output-recording-protocol.lisp
@@ -154,7 +154,7 @@
 (defmethod output-record-set-position* ((r output-record) new-x new-y)
   
  ;; (when (and (zerop new-x)(zerop new-y)) (break "zerop"))
-  (when (minusp new-x) (break))
+  (when (minusp new-x) (warn "Zerop new-x ~S,~S" new-x new-y))
   (multiple-value-bind
       (old-x old-y)
       (output-record-position* r)
@@ -190,7 +190,9 @@
 ;  nil)
 
 (defun replay (record stream &optional (region +everywhere+))
-  (replay-output-record record stream region))
+  ;; Why did the spec not suggest this? or did I misread it.
+  (when (stream-draw-p stream)
+    (replay-output-record record stream region)))
 
 (defmethod replay-output-record (record stream &optional (region +everywhere+))
   (map-over-output-record-children
diff --git a/clim/presentations.lisp b/clim/presentations.lisp
index 8b31394147f501b6a8b0370e96c240229ab96e3c..7c0c3befbe0cae9357281b4a1bd6bc29a617f0de 100644
--- a/clim/presentations.lisp
+++ b/clim/presentations.lisp
@@ -19,7 +19,7 @@
 ;; applicable.
 ;;
 
-;; $fiHeader: presentations.lisp,v 1.1 91/09/09 14:53:12 cer Exp Locker: cer $
+;; $fiHeader: presentations.lisp,v 1.1 91/11/25 10:01:12 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -400,7 +400,8 @@ Copyright (c) 1991, Franz Inc. All rights reserved
 
 (defun highlighted-presentation (stream &optional (prefer-pointer-window t))
   (let ((history-window (if prefer-pointer-window (find-appropriate-window stream) stream)))
-    (when history-window
+    (when (and history-window
+	       (slot-exists-p history-window 'highlighted-presentation))
       (slot-value history-window 'highlighted-presentation))))
 
 (defun set-highlighted-presentation (stream presentation &optional (prefer-pointer-window t))
diff --git a/clim/sysdcl.lisp b/clim/sysdcl.lisp
index 1068d6d601538794990c8e8fd55313a73e870c3c..40053eeeb493c23a24b103db1fb76d2b23eb8307 100644
--- a/clim/sysdcl.lisp
+++ b/clim/sysdcl.lisp
@@ -78,10 +78,11 @@
   ("db-layout")
   ("db-box")
   ("db-table")
-
+  
   ;; db-border?????
 
   ("gadgets")
+  ("db-scroll")
   
   ("db-stream")
   
@@ -95,7 +96,9 @@
   
   ("accept-values"
    :load-before-compile ("clim-defs" "incremental-redisplay"))
-  
+
+  ("menus")
+  ("text-formatting")
   ("stream-trampolines"
    :load-before-compile ("defprotocol" "stream-defprotocols")
    ))
diff --git a/clim/text-formatting.lisp b/clim/text-formatting.lisp
index 1ea6318fb75b73da101a56881723f2b55a1ebdb8..7cb8e8f369c7566884ccc20c1b0818ec85ec5ab3 100644
--- a/clim/text-formatting.lisp
+++ b/clim/text-formatting.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: text-formatting.lisp,v 1.8 91/08/05 14:35:42 cer Exp $
+;; $fiHeader: text-formatting.cl,v 1.1 91/12/10 18:50:29 cer Exp Locker: cer $
 
 (in-package :clim)
 
@@ -60,7 +60,7 @@
     ;; but it does contribute to the width of the line
     (when prefix
       (stream-write-string stream prefix))
-    (setq current-width (+ prefix-width (text-size stream buffer)))))
+    (setq current-width (+ prefix-width (silica::text-size stream buffer)))))
 
 (defmethod stream-terpri ((filling-stream filling-stream))
   (with-slots (stream current-width) filling-stream
@@ -76,7 +76,7 @@
 	   (setq current-width 0))
 	  (t
 	   (vector-push-extend char buffer)
-	   (incf current-width (text-size stream char))
+	   (incf current-width (silica::text-size stream char))
 	   ;; We need to do the FILLING-STREAM-WRITE-BUFFER for every
 	   ;; character since it needs to know as soon as output crosses
 	   ;; the fill width.
@@ -135,7 +135,7 @@
   (write-buffer-and-continue filling-stream
 			     #'close-current-text-output-record wrapped))
 
-(defresource filling-stream (stream fill-width break-characters prefix prefix-width)
+(clim-utils::defresource filling-stream (stream fill-width break-characters prefix prefix-width)
   :constructor (make-instance 'filling-stream
 			      :buffer (make-array 100 :element-type 'extended-char
 						      :fill-pointer 0
@@ -159,10 +159,10 @@
   (check-type break-characters list)
   (check-type after-line-break (or null string))
   (let ((fill-width (process-spacing-arg stream fill-width 'filling-output ':fill-width))
-	(prefix-width (if after-line-break (text-size stream after-line-break) 0)))
+	(prefix-width (if after-line-break (silica::text-size stream after-line-break) 0)))
     (assert (< prefix-width fill-width) ()
 	    "The prefix string ~S is wider than the fill width" after-line-break)
-    (using-resource (filling-stream filling-stream
+    (clim-utils::using-resource (filling-stream filling-stream
 		     stream fill-width break-characters after-line-break prefix-width)
       (unwind-protect
 	  (progn
diff --git a/draw-sheets.lisp b/draw-sheets.lisp
index fc11149698b14704e9c2a06b3701e1dd83d35236..3eed2b34b353e8c5c6af42657283c5b98460466f 100644
--- a/draw-sheets.lisp
+++ b/draw-sheets.lisp
@@ -13,7 +13,9 @@
 
 (defun graph-sheet (sheet &rest args)
   (apply #'graph-descendants
-	 sheet
+	 (etypecase sheet
+	   (silica::application-frame (clim-internals::frame-top-level-sheet sheet))
+	   (silica::sheet sheet))
 	 :display 'gr-sheet-display
 	 :gnode-class 'sheet-gnode
 	 :title "Sheet hierarchy"
diff --git a/misc/go.lisp b/misc/go.lisp
index b4d6cf503bba10a77c4912ed0aa03f67f345febf..dd3346429fa32682aa81647e70962f95801031b3 100644
--- a/misc/go.lisp
+++ b/misc/go.lisp
@@ -18,6 +18,9 @@
 ;; applicable.
 ;;
 
+(setq excl::*record-source-file-info* t
+      excl::*load-source-file-info* t)
+
 (without-package-locks
  (load "sys/defsystem")
  (load "sys/sysdcl"))
@@ -60,4 +63,4 @@
   (load "draw-sheets.cl")
   )
 
-(load "clim/test")
+(load "test/test")
diff --git a/silica/db-box.lisp b/silica/db-box.lisp
index 1f0ba97ab5782c35a19b0fefcceea13b98bd14dc..9dddfd63f79415a4be57a7118fb9a71f0509498a 100644
--- a/silica/db-box.lisp
+++ b/silica/db-box.lisp
@@ -30,16 +30,23 @@
 
 (defclass box-pane (mute-input-mixin
 		    pane-background-mixin
-	
 		    composite-pane 
-		    list-contents-mixin
+		    #+ignore list-contents-mixin
 		    space-req-cache-mixin)
-    ((space :initform 1 :initarg :space)))
+	  ((space :initform 1 :initarg :space)
+	   contents))
 
 (defmethod initialize-instance :after 
 	   ((pane box-pane) &key contents &allow-other-keys)
-  (insert-panes pane contents))
-
+  (dolist (child contents)
+    (etypecase child
+      (number)
+      (pane
+       (adopt-child pane child))))
+  (with-slots ((c contents)) pane
+    (setf c contents)))
+
+#+ignore
 (defmethod insert-pane ((lcm box-pane) pane
 			&key position batch-p &allow-other-keys)
 
@@ -150,6 +157,28 @@
 			 space-req-min-height)
 	       (:width :max-width :min-width :height :max-height :min-height)))
 
+
+(defmethod allocate-space ((contract hbox-pane) width height)
+  (with-slots (contents space space-req) contract
+    (unless space-req (compose-space contract))
+    (let ((sizes 
+	   (allocate-space-to-items
+	    width
+	    space-req
+	    contents
+	    #'space-req-min-width
+	    #'space-req-width
+	    #'space-req-max-width
+	    #'compose-space))
+	  (x 0))
+      (mapc #'(lambda (sheet size)
+		(move-and-resize-sheet* 
+		 sheet x 0 (frob-size size width x) height)
+		(incf x size))
+	    contents
+	    sizes))))
+
+
 (defmethod allocate-space ((contract hbox-pane) width height)
   (flet ((move-and-resize-entry (entry min-x width height)
 	   (move-and-resize-sheet* entry min-x 0 width height)))
@@ -163,7 +192,7 @@
 
 (defclass vbox-pane (box-pane)
     ()
-  (:default-initargs :reverse-p t))
+  )
 
 (defmethod compose-space ((contract vbox-pane))
   (compose-box contract (space-req-height
@@ -174,21 +203,31 @@
 			 space-req-min-width)
 	       (:height :max-height :min-height :width :max-width :min-width)))
 
-(defmethod allocate-space ((contract vbox-pane) width height &aux (oheight height))
-  (flet ((move-and-resize-entry (entry min-y height width)
-	   (move-and-resize-sheet* entry 0 min-y 
-				   width ; DREADful kludge to make
-					 ; sure that we do not
-					 ; make the sheet to big and
-					 ; cause the request to fail
-				   (min (1- (- oheight min-y)) height))))
-    (allocate-box contract height width move-and-resize-entry
-		  (space-req-height
-		   space-req-max-height
-		   space-req-min-height
-		   #+ignore space-req-width 
-		   #+ignore space-req-max-width
-		   #+ignore space-req-min-width))))
+(defmethod allocate-space ((contract vbox-pane) width height)
+  (with-slots (contents space space-req) contract
+    (unless space-req (compose-space contract))
+    (let ((sizes 
+	   (allocate-space-to-items
+	    height
+	    space-req
+	    contents
+	    #'space-req-min-height
+	    #'space-req-height
+	    #'space-req-max-height
+	    #'compose-space))
+	  (y 0))
+      (mapc #'(lambda (sheet size)
+		(move-and-resize-sheet* sheet 
+					0 
+					y
+					width 
+					(frob-size size height y))
+		(incf y size))
+	    contents
+	    sizes))))
+
+(defun frob-size (wanted-size available where-we-are-now)
+  (min wanted-size (1- (- available where-we-are-now))))
 		   
 
 
diff --git a/silica/db-layout.lisp b/silica/db-layout.lisp
index e8925b4d233693e9d492ea5626fa8266847b3f89..69419c694106a388eeb3b64b5ac4d02d4d21f9a3 100644
--- a/silica/db-layout.lisp
+++ b/silica/db-layout.lisp
@@ -47,6 +47,11 @@
 (defmethod allocate-space ((pane leaf-mixin) width height)
   (declare (ignore width height)))
 
+(warn "boug")
+
+(defmethod allocate-space (pane width height)
+  (declare (ignore width height)))
+
 (defmethod space-req-changed ((composite composite-pane) child)
   (declare (ignore child))
   (space-req-changed (sheet-parent composite) composite))
@@ -74,7 +79,10 @@
 	   ((pane layout-mixin) &key resize-frame &allow-other-keys)
   (if resize-frame
       (relayout-frame (pane-frame pane))
-      (space-req-changed (sheet-parent pane) pane)))
+    (space-req-changed (sheet-parent pane) pane)))
+
+(defmethod space-req-changed (parent child)
+  nil)
 
 #||
 
@@ -177,9 +185,9 @@
   (when (or width max-width min-width height max-height min-height)
     (setf (slot-value pane 'client-space-req)
       (make-space-req :width (or width 0) :height (or height 0) 
-		      :max-width (or max-width width 0) 
+		      :max-width (or max-width width +fill+)
 		      :min-width (or min-width width 0)
-		      :max-height (or max-height height 0)
+		      :max-height (or max-height height +fill+)
 		      :min-height (or min-height height 0)))))
 
 (defmethod compose-space ((pane client-space-req-mixin))
@@ -286,6 +294,9 @@
 (defmethod clear-space-req-cache ((pane layout-mixin))
   nil)
 
+(defmethod clear-space-req-cache ((pane t))
+  nil)
+
 (defmethod clear-space-req-cache ((pane space-req-cache-mixin))
   (with-slots (space-req) pane
     (setf space-req nil)))
@@ -300,6 +311,11 @@
 		 (clear-space-req-cache sheet))
 	     sheet))
 
+(defun clear-space-req-caching-in-ancestors (menu)
+  (do ((parent (sheet-parent menu) (sheet-parent parent)))
+      ((null parent))
+    (clear-space-req-cache parent)))
+
 ;;;
 ;;; Wrapping Space Mixin
 ;;;
@@ -368,3 +384,46 @@
 		  (bounding-rectangle-height pane)))
 
 
+
+;;; Generally useful layout function
+;;; Used all over to satisfy constraints
+
+(defun allocate-space-to-items (given wanted items min-size
+				desired-size max-size item-size)
+  (flet ((desired-size (x) (funcall desired-size x))
+	 (min-size (x) (funcall min-size x))
+	 (max-size (x) (funcall max-size x))
+	 (item-size (x) (funcall item-size x)))
+    (let ((stretch-p (>= given (desired-size wanted)))
+	  extra give used sizes)
+      
+      (if stretch-p
+	  (setq give (- (max-size wanted) (desired-size wanted))
+		extra (min (- given (desired-size wanted)) give))
+	(setq give (- (desired-size wanted) (min-size wanted))
+	      extra (min (- (desired-size wanted) given) give)))
+      
+      (dolist (item items)
+	(let* ((item-size (item-size item))
+	       (alloc (desired-size item-size)))
+	  (when (> give 0)
+	    (if stretch-p
+		(progn
+		  (setq used (/ (* (- (max-size item-size)
+				      (desired-size item-size))
+				   extra)
+				give))
+		  (incf alloc used)
+		  (decf give (- (max-size item-size)
+				(desired-size item-size))))
+	      (progn
+		(setq used (/ (* (- (desired-size item-size)
+				    (min-size item-size))
+				 extra)
+			      give))
+		(decf alloc used)
+		(decf give (- (desired-size item-size)
+			      (min-size item-size)))))
+	    (decf extra used))
+	    (push alloc sizes)))
+      (nreverse sizes))))
diff --git a/silica/db-table.lisp b/silica/db-table.lisp
index cdf99d2d5b2bf0793045bbe375879790fcf94668..b562e6d0d9fa0770bd876245bca24bf530fae402 100644
--- a/silica/db-table.lisp
+++ b/silica/db-table.lisp
@@ -28,198 +28,143 @@
 ;;; Table
 ;;;
 
-(defclass table-pane (pane-background-mixin
-			      mute-input-mixin
-			      composite-pane 
-			      space-req-cache-mixin)
-    ((contents :accessor table-contents)
-     (rows)
-     (columns)
-     (row-h :initform nil)
-     (column-w :initform nil)
-     ;; ??? order of space, h and heightpace initarg matters with autoconstructors
-     (widthpace :initform 0 :initarg :space :initarg :widthpace)
-     (heightpace :initform 0 :initarg :space :initarg :heightpace)))
 
 
-(defmethod initialize-instance :after 
-	   ((pane table-pane) &key contents &allow-other-keys)
+(defclass table-pane (mute-input-mixin
+		      pane-background-mixin
+		      composite-pane 
+		      space-req-cache-mixin)
+	  (row-space-reqs column-space-reqs contents))
 
-;;; The space composition and allocation for tables depends on there being
-;;; no empty rows or columns in the data structure; otherwise, the space
-;;; request comes back with MOST-POSITIVE-FIXNUM size requirements in the
-;;; direction of the empty row/column.  The following two forms delete the
-;;; empty rows and columns.  The row deletion is easy: the data structure is
-;;; set up for that purpose.  The column deletetion is more complex.
-;;;  -- rsl 13 November 1990
 
-  ;; Delete empty rows.
-  (setf contents (delete-if #'(lambda (row) (every #'null row)) 
-			    contents))
+(defmethod initialize-instance :after ((pane table-pane) &key contents)
+  ;; The contents should be a list of lists
+  (with-slots ((c contents)) pane
+    (setf c (make-array (list (length contents)
+			      (length (car contents)))
+			:initial-contents contents)))
+  (dolist (c contents)
+    (dolist (d c)
+      (when d (adopt-child pane d)))))
 
-  ;; Delete empty columns when there are any; this CONSes too much otherwise.
-  (when (block there-is-an-empty-column
-	  (flet ((check-for-empty-column (&rest column)
-		   (declare (dynamic-extent column))
-		   (when (every #'null column)
-		     (return-from there-is-an-empty-column t))))
-	    (declare (dynamic-extent #'check-for-empty-column))
-	    (apply #'mapc #'check-for-empty-column contents))
-	  nil)  ;; -> No empty columns
-    ;; Yes, there is at least one empty column
-    (setf contents
-	    (flet ((delete-column-if-empty (&rest column)
-		     (declare (clim-utils::non-dynamic-extent column))
-		     (if (every #'null column)
-			 nil			;Delete this column entirely
-			 (list column))))
-		     (declare (dynamic-extent #'delete-column-if-empty))
-		     (apply #'mapcan #'delete-column-if-empty contents))))
 
-  (with-slots ((table-contents contents)
-	       rows columns) pane
-    (setf rows (length contents))
-    (setf columns (apply #'max (mapcar #'length contents)))
-    (let* (i j)
+(defmacro tabling (options &rest contents)
+  `(realize-pane 'table-pane
+		 :contents (list ,@(mapcar #'(lambda (x) `(list ,@x)) contents))
+		 ,@options))
 
-      (setf table-contents (make-array (list rows columns) 
-				       :initial-element nil))
-      (setq i 0)
-      (dolist (row
-		;; Vertical list are easier to specify top to bottom, but
-		;; easier to deal with bottom to top.  
-		(reverse contents))
-	(setq j 0)
-	(dolist (item row)
-	  (cond ((null item) nil)
-		((panep item) (adopt-child 
-			       pane
-			       (setf (aref table-contents i j) item)))
-		((eq item :give-left) (warn "Give left not supported"))
-		((eq item :give-down) (warn "Give down not supported"))
-		(t (error "Illegal element in table contents")))
-	  (incf j))
-	(incf i)))))
+#+ignore
+(tabling (:space space)
+		 (vscrollbar viewport)
+		 (nil        hscrollbar))
 
-(defmethod compose-space ((pane table-pane))
-  (with-slots (rows columns contents widthpace heightpace row-h column-w) pane
-    (let (size 
-	  max-size
-	  min-size
-	  (width 0) (max-width 0) (min-width 0)
-	  (height 0) (max-height 0) (min-height 0))
-      (setf row-h (or row-h (make-array rows :initial-element 0)))
-      (setf column-w (or column-w (make-array columns :initial-element 0)))
-      (dotimes (i rows)
-	(setq size 0)
-	(setq max-size most-positive-fixnum)
-	(setq min-size 0)
-	(dotimes (j columns)
-	  (when (aref contents i j)
-	    (let ((space-req (compose-space (aref contents i j))))
-	      (setq size  (max size (space-req-height space-req)))
-	      (setq max-size (min max-size (+ (space-req-height space-req)
-					      (space-req-max-height space-req))))
-	      (setq min-size (max min-size (- (space-req-height space-req)
-					      (space-req-min-height space-req)))))))
-	(setf (aref row-h i) (list size 
-				   (max (- max-size size) 0)
-				   (max (- size min-size) 0)
-				   nil)))
-      (dotimes (i rows)
-	(let ((req (aref row-h i)))
-	  (incf height  (first req))
-	  (incf max-height (second req))
-	  (incf min-height (third req))))
-      (incf height (* (1- rows) heightpace))
-      
-      (dotimes (j columns)
-	(setq size 0)
-	(setq max-size most-positive-fixnum)
-	(setq min-size 0)
-	(dotimes (i rows)
-	  (when (aref contents i j)
-	    (let ((space-req (compose-space (aref contents i j))))
-	      (setq size  (max size (space-req-width space-req)))
-	      (setq max-size (min max-size (+ (space-req-width space-req)
-					      (space-req-max-width space-req))))
-	      (setq min-size (max min-size (- (space-req-width space-req)
-					      (space-req-min-width space-req)))))))
-	(setf (aref column-w j) (list size 
-				      (max (- max-size size) 0)
-				      (max (- size min-size) 0)
-				      nil)))
-      (dotimes (j columns)
-	(let ((req (aref column-w j)))
-	  (incf width  (first req))
-	  (incf max-width (second req))
-	  (incf min-width (third req))))
-      (incf width (* (1- columns) widthpace))
-      (make-space-req :width width :max-width max-width :min-width min-width :height height :max-height max-height :min-height min-height))))
-
-(defmacro allocate-to-rows (contract alloc-major rows row-h accessors)
-  (let ((major  (first accessors))
-	(major+ (second accessors))
-	(major- (third accessors))
-	(row-major  'first)
-	(row-major+ 'second)
-	(row-major- 'third)
-	(row-alloc  'fourth))
-    `(with-slots (space-req) ,contract
-       (let ((stretch-p (> ,alloc-major (,major space-req)))
-	     give extra used)
-	 (if stretch-p
-	     (progn (setq give (,major+ space-req))
-		    (setq extra (min (- ,alloc-major (,major space-req))
-				     give)))
-	     (progn (setq give (,major- space-req))
-		    (setq extra (min (- (,major space-req) ,alloc-major)
-				     give))))
-	 (dotimes (i ,rows)
-	   (let* ((row-space-req (aref ,row-h i))
-		  (alloc (,row-major row-space-req)))
-	     (when (> give 0)
-	       (if stretch-p
-		   (progn (setq used (/ (* (,row-major+ row-space-req) extra)
-					give))
-			  (incf alloc used)
-			  (decf give (,row-major+ row-space-req)))
-		   (progn (setq used (/ (* (,row-major- row-space-req)
-					   extra)
-					give))
-			  (decf alloc used)
-			  (decf give (,row-major+ row-space-req))))
-	       (decf extra used))
-	     (setf (,row-alloc row-space-req) alloc)))))))
+(defmethod compose-space ((x table-pane))
+  (with-slots (contents) x
+    (let ((omin-w 0)
+	  (omin-h 0)
+	  (oh 0)
+	  (ow 0)
+	  (omax-h 0)
+	  (omax-w 0)
+	  row-srs
+	  column-srs)
 
-(defmethod allocate-space ((pane table-pane) width height)
-  ;; assuming that pane has been composed previously.
-  (with-slots (rows columns contents widthpace heightpace row-h column-w space-req)
-      pane
-    
-    (unless space-req (compose-space pane)) ;; ?? Depends on it being here
-    
-    (allocate-to-rows pane height rows row-h
-		      (space-req-height
-		       space-req-max-height space-req-min-height
-		       space-req-width space-req-max-width space-req-min-width))
-    (allocate-to-rows pane width columns column-w
-		      (space-req-width 
-		       space-req-max-width space-req-min-width
-		       space-req-height space-req-max-height space-req-min-height))
+      ;; Iterate over the rows, determining the height of each
+      
+      (dotimes (row (array-dimension contents 0))
+	(let ((min-h 0)
+	      (h 0)
+	      (max-h 0))
+	  (dotimes (column (array-dimension contents 1))
+	    (let ((item (aref contents row column)))
+	      (when item
+		(let ((isr (compose-space item)))
+		  ;; Max the heights
+		  (maxf h (space-req-height isr))
+		  (maxf min-h (space-req-min-height isr))
+		  (maxf max-h (space-req-max-height isr))))))
 
-    ;; Now we should know what to do, so let's do it.
-    (let (min-x min-y width height) 
-      (setq min-y 0)
-      (dotimes (i rows)
-	(setq min-x 0)
-	(setq height (fourth (aref row-h i)))
-	(dotimes (j columns)
+	  (push
+	   (make-space-req
+	    :width 0
+	    :min-height min-h :height h :max-height max-h)
+	   row-srs)
 	  
-	  (setq width (fourth (aref column-w j)))
-	  (when (aref contents i j)
-	    (move-and-resize-sheet* (aref contents i j) 
-				    min-x min-y width height))
-	  (incf min-x (+ width widthpace)))
-	(incf min-y (+ height heightpace))))))
+	  ;; Add the heights
+	  (incf oh h)
+	  (incf omin-h min-h)
+	  (incf omax-h max-h)))
+      
+      (setf (slot-value x 'row-space-reqs) (nreverse row-srs))
+      
+      ;; Iterate over the columns determing the widths of each
+            
+      (dotimes (column (array-dimension contents 1))
+	(let ((min-w 0)
+	      (w 0)
+	      (max-w 0))
+	
+	  (dotimes (row (array-dimension contents 0))
+	    (let ((item (aref contents row column)))
+	      (when item
+		(let ((isr (compose-space item)))
+		  ;; Max the widths
+		  (maxf w (space-req-width isr))
+		  (maxf min-w (space-req-min-width isr))
+		  (maxf max-w (space-req-max-width isr))))))
+
+	  (push
+	   (make-space-req
+	    :min-width min-w :width w :max-width max-w
+	    :height 0)
+	   column-srs)
+	
+	  (incf ow w)
+	  (incf omin-w min-w)
+	  (incf omax-w max-w)))
+      
+      
+      (setf (slot-value x 'column-space-reqs) (nreverse column-srs))
+      
+      (make-space-req
+       :min-width omin-w :width ow :max-width omax-w
+       :min-height omin-h :height oh :max-height omax-h))))
 
+(defmethod allocate-space ((x table-pane) width height)
+  (with-slots (contents column-space-reqs 
+			row-space-reqs space-req) x
+    (unless space-req (compose-space x))
+    
+    (let ((row-heights
+	   (allocate-space-to-items
+	    height
+	    space-req
+	    row-space-reqs
+	    #'space-req-min-height
+	    #'space-req-height
+	    #'space-req-max-height
+	    #'identity))
+	  (column-widths
+	   (allocate-space-to-items
+	    width
+	    space-req
+	    column-space-reqs
+	    #'space-req-min-width
+	    #'space-req-width
+	    #'space-req-max-width
+	    #'identity))
+	  (y 0))
+      (dotimes (row (array-dimension contents 0))
+	(let ((row-height (pop row-heights))
+	      (column-widths column-widths)
+	      (x 0))
+	  (dotimes (column (array-dimension contents 1))
+	    (let ((column-width (pop column-widths))
+		  (item (aref contents row column)))
+	      (when item
+		(move-and-resize-sheet*
+		 item x y 
+		 (min column-width (1- (- width x)))
+		 (min row-height (1- (- height y)))))
+	      (incf x column-width)))
+	  (incf y row-height))))))
diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp
index 991e7ab6f8cea55dbebf83da79876fe40300070c..09f3b99e4308392d224e96086bf620c74e93477e 100644
--- a/silica/gadgets.lisp
+++ b/silica/gadgets.lisp
@@ -61,9 +61,6 @@
 
 ;;; Then there is the layout stuff and scrolling macros
 
-
-(defmacro horizontally () ())
-(defmacro tabling () ())
 (defmacro form () ())
 
 (defmacro scrolling (options contents)
@@ -73,13 +70,13 @@
 
 (defmethod realize-pane-internal ((framem frame-manager) (frame application-frame)
 				  name &rest options)
-  (apply #'make-instance name options))
+  (apply #'make-instance 
+	 name
+	 :frame frame
+	 :frame-manager framem
+	 options))
+
 
-(defmethod note-sheet-region-changed :after ((sheet gadget) &key port)
-  (declare (ignore port))
-  (allocate-space sheet
-		  (sheet-width sheet) 
-		  (sheet-height sheet)))
 
 ;;;;;;;; Whats the interface to different types of window: main, dialog,..
 
diff --git a/silica/layout.lisp b/silica/layout.lisp
index f0c628cab251514e4fc14b64c64957af5b2bcb98..826f1868bb64dafc65b705259a4d264b0b9112ed 100644
--- a/silica/layout.lisp
+++ b/silica/layout.lisp
@@ -86,6 +86,11 @@
 		 :contents (list ,@contents) ,@options))
 
 
+(defmacro horizontally (options &rest contents)
+  `(realize-pane 'hbox-pane
+		 :contents (list ,@contents) ,@options))
+
+
 (defmethod resize-sheet* ((sheet sheet) width height)
   (when (or width height)
     (with-bounding-rectangle* (minx miny maxx maxy) sheet
@@ -119,122 +124,128 @@
 		standard-repainting-medium
 		permanent-medium-sheet-output-mixin
 		mute-repainting-mixin)
-	  ())
+	  ((frame :reader pane-frame :initarg :frame)
+	   (framem :reader pane-frame-mamager :initarg :frame-manager)))
+
+
+(defmethod note-sheet-region-changed :after ((sheet pane) &key port)
+  (declare (ignore port))
+  (allocate-space sheet
+		  (sheet-width sheet) 
+		  (sheet-height sheet)))
 
 (defmethod panep ((x pane)) t)
 (defmethod panep ((x t)) nil)
 
 (defclass leaf-mixin (sheet-leaf-mixin) ())
 (defclass composite-pane (pane sheet-multiple-child-mixin) ())
-
 (defclass mute-input-mixin (sheet-mute-input-mixin) ())
 (defclass pane-background-mixin () ())
 
-
-(defclass list-contents-mixin ()
-    ((contents :initform nil)
-     (nslots :initform nil :initarg :nslots)
-     ;; Reverse-p is provided because it makes sense to let users specify
-     ;; vertical lists from top to bottom, but internally it is easier to deal
-     ;; with bottom to top, because of the lower left coordinate system.
-     ;; For example, a user would like to list the vbox contents from top to
-     ;; bottom, while y coords increases from bottom to top. Whereas with
-     ;; a hbox, user specifys left to right just as x coord increases left
-     ;; to right.
-     ;; 
-     ;; A problem with reverse-p solution is that when new panes are inserted, 
-     ;; all panes before them in the user's view of contents changes coord,
-     ;; but the user may expect the one's later in the list to change coords.
-     ;; For example in a vertical list, adding a pane to the end will
-     ;; reposition all of the list items.
-     
-     ;; A possible solution is to user a upper left coordinate
-     ;; system so that added items have absolute y values that are increasing.
-     ;; Once upon a time Doug told me he prefered this, but it'll have to wait
-     ;; for now.   A deeper problem with this solution is that different panes
-     ;; would have different coordinate systems which maybe confusing if the
-     ;; coordinate system is exposed to the client in anyway.
-     (reverse-p :initform nil :initarg :reverse-p)))
-
-;;;
-;;; Insertion/Deletion Protocols
-;;;
-
-(defmethod contents ((lcm list-contents-mixin))
-  (with-slots (reverse-p contents) lcm
-    (if reverse-p (reverse contents)
-	contents)))
-    
-(defmethod (setf contents) (new-contents (lcm list-contents-mixin))
-  (with-slots (reverse-p contents children) lcm
-    (dolist (pane contents)
-      (disown-child lcm pane))
-    (dolist (pane new-contents)
-      (adopt-child lcm pane))
-    (setf contents (if reverse-p (reverse new-contents)
-		       new-contents)
-	  ;; So that things repaint from top to bottom
-	  ;; ??? However, it only work is you go through this method.
-	  children (if reverse-p (nreverse children)
-			  children))
-    
-    (space-req-changed (sheet-parent lcm) lcm)))
-
-
-
-(defun check-position (position reverse-p contents)
-  (let ((len (length contents)))
-    (when reverse-p 
-      (setq position (if position (- len position) 0)))
-    (unless position (setq position len))
-    (check-type position number)
-    (assert (and (<= 0 position) (<= position len))
-	    (position)
-	    "Position argument out of bounds")
-    position))
-
-(defmethod insert-panes ((lcm list-contents-mixin) panes
-			 &key position &allow-other-keys)
-  (with-slots (reverse-p contents) lcm
-    (setq position (check-position position reverse-p contents))
-    (dolist (pane panes)
-      (insert-pane lcm pane :position position :batch-p t)
-      (unless reverse-p (incf position)))
-    (space-req-changed (sheet-parent lcm) lcm)))
-
-(defmethod insert-pane ((lcm list-contents-mixin) (pane pane) 
-			&key position batch-p &allow-other-keys)
-  (with-slots (contents reverse-p) lcm
-    (unless batch-p
-      (setq position (check-position position reverse-p contents)))
-    (if (zerop position)
-	(push pane contents)
-	(let ((tail (nthcdr (1- position) contents)))
-	  (setf (cdr tail) 
-		(cons pane (cdr tail)))))
-    (adopt-child lcm pane)
-    (unless batch-p
-      (space-req-changed (sheet-parent lcm) lcm))))
-			      
-(defmethod remove-panes ((lcm list-contents-mixin) panes)
-  (dolist (pane panes)
-    (with-slots (contents) lcm
-      (setf contents (delete pane contents))
-      (disown-child lcm pane)))
-  (space-req-changed (sheet-parent lcm) lcm))
-
-(defmethod remove-pane ((lcm list-contents-mixin) (pane pane)
-			&key batch-p &allow-other-keys)
-  (with-slots (contents) lcm
-    (setf contents (delete pane contents :test #'eq))
-    (disown-child lcm pane)
-    (unless batch-p (space-req-changed (sheet-parent lcm) lcm))))
-
-(defmethod space-req-changed :before (parent (lcm list-contents-mixin))
-  #-PCL ;; PCL uses this variable for method-table cache misses, unfortunately.
-  (declare (ignore parent))
-  (with-slots (nslots contents) lcm
-    (setf nslots (length contents))))
+;(defclass list-contents-mixin ()
+;    ((contents :initform nil)
+;     (nslots :initform nil :initarg :nslots)
+;     ;; Reverse-p is provided because it makes sense to let users specify
+;     ;; vertical lists from top to bottom, but internally it is easier to deal
+;     ;; with bottom to top, because of the lower left coordinate system.
+;     ;; For example, a user would like to list the vbox contents from top to
+;     ;; bottom, while y coords increases from bottom to top. Whereas with
+;     ;; a hbox, user specifys left to right just as x coord increases left
+;     ;; to right.
+;     ;; 
+;     ;; A problem with reverse-p solution is that when new panes are inserted, 
+;     ;; all panes before them in the user's view of contents changes coord,
+;     ;; but the user may expect the one's later in the list to change coords.
+;     ;; For example in a vertical list, adding a pane to the end will
+;     ;; reposition all of the list items.
+;     
+;     ;; A possible solution is to user a upper left coordinate
+;     ;; system so that added items have absolute y values that are increasing.
+;     ;; Once upon a time Doug told me he prefered this, but it'll have to wait
+;     ;; for now.   A deeper problem with this solution is that different panes
+;     ;; would have different coordinate systems which maybe confusing if the
+;     ;; coordinate system is exposed to the client in anyway.
+;     (reverse-p :initform nil :initarg :reverse-p)))
+;
+;;;;
+;;;; Insertion/Deletion Protocols
+;;;;
+;
+;(defmethod contents ((lcm list-contents-mixin))
+;  (with-slots (reverse-p contents) lcm
+;    (if reverse-p (reverse contents)
+;	contents)))
+;    
+;(defmethod (setf contents) (new-contents (lcm list-contents-mixin))
+;  (with-slots (reverse-p contents children) lcm
+;    (dolist (pane contents)
+;      (disown-child lcm pane))
+;    (dolist (pane new-contents)
+;      (adopt-child lcm pane))
+;    (setf contents (if reverse-p (reverse new-contents)
+;		       new-contents)
+;	  ;; So that things repaint from top to bottom
+;	  ;; ??? However, it only work is you go through this method.
+;	  children (if reverse-p (nreverse children)
+;			  children))
+;    
+;    (space-req-changed (sheet-parent lcm) lcm)))
+;
+;
+;
+;(defun check-position (position reverse-p contents)
+;  (let ((len (length contents)))
+;    (when reverse-p 
+;      (setq position (if position (- len position) 0)))
+;    (unless position (setq position len))
+;    (check-type position number)
+;    (assert (and (<= 0 position) (<= position len))
+;	    (position)
+;	    "Position argument out of bounds")
+;    position))
+;
+;(defmethod insert-panes ((lcm list-contents-mixin) panes
+;			 &key position &allow-other-keys)
+;  (with-slots (reverse-p contents) lcm
+;    (setq position (check-position position reverse-p contents))
+;    (dolist (pane panes)
+;      (insert-pane lcm pane :position position :batch-p t)
+;      (unless reverse-p (incf position)))
+;    (space-req-changed (sheet-parent lcm) lcm)))
+;
+;(defmethod insert-pane ((lcm list-contents-mixin) (pane pane) 
+;			&key position batch-p &allow-other-keys)
+;  (with-slots (contents reverse-p) lcm
+;    (unless batch-p
+;      (setq position (check-position position reverse-p contents)))
+;    (if (zerop position)
+;	(push pane contents)
+;	(let ((tail (nthcdr (1- position) contents)))
+;	  (setf (cdr tail) 
+;		(cons pane (cdr tail)))))
+;    (adopt-child lcm pane)
+;    (unless batch-p
+;      (space-req-changed (sheet-parent lcm) lcm))))
+;			      
+;(defmethod remove-panes ((lcm list-contents-mixin) panes)
+;  (dolist (pane panes)
+;    (with-slots (contents) lcm
+;      (setf contents (delete pane contents))
+;      (disown-child lcm pane)))
+;  (space-req-changed (sheet-parent lcm) lcm))
+;
+;(defmethod remove-pane ((lcm list-contents-mixin) (pane pane)
+;			&key batch-p &allow-other-keys)
+;  (with-slots (contents) lcm
+;    (setf contents (delete pane contents :test #'eq))
+;    (disown-child lcm pane)
+;    (unless batch-p (space-req-changed (sheet-parent lcm) lcm))))
+;
+;(defmethod space-req-changed :before (parent (lcm list-contents-mixin))
+;  #-PCL ;; PCL uses this variable for method-table cache misses, unfortunately.
+;  (declare (ignore parent))
+;  (with-slots (nslots contents) lcm
+;    (setf nslots (length contents))))
 
 
 
diff --git a/silica/medium.lisp b/silica/medium.lisp
index 5761d4a32ea3036af29df012c2a475d43b84e6d8..d5e7e0638d4bc8d6d763f24768c74d814c3e7282 100644
--- a/silica/medium.lisp
+++ b/silica/medium.lisp
@@ -69,6 +69,7 @@
 
 (defmethod invoke-with-drawing-options ((medium medium) function 
 					&key 
+					(line-thickness nil line-thickness-p)
 					(ink nil ink-p)
 					(text-style nil text-style-p)
 					(transformation nil trans-p)
@@ -79,7 +80,7 @@
 					(text-size nil text-size-p))
   (when (or text-size-p text-face-p text-family-p line-style-p
 	    clipping-region-p)
-    (error "unhandled option to invoke-with-drawing-options"))
+    (warn "unhandled option to invoke-with-drawing-options"))
   
   (let ((old-ink (if ink-p (medium-ink medium)))
 	(old-trans (if trans-p (medium-transformation medium)))
diff --git a/silica/mirror.lisp b/silica/mirror.lisp
index ac626071c799dfcdc81f404e23b830131bf29c58..e98ad1ef77937d0dd511aefcd47c861c67c38a9c 100644
--- a/silica/mirror.lisp
+++ b/silica/mirror.lisp
@@ -178,18 +178,31 @@
 	   (mapc #'invalidate-cached-regions (sheet-children sheet))))
 
 
+(warn "This sucks big")
+
+(defmethod invalidate-cached-transformations :after ((sheet mirrored-sheet-mixin))
+  (when (sheet-direct-mirror sheet)
+    (update-mirror-region (port sheet) sheet)))
+
 (defmethod note-sheet-region-changed :after ((sheet mirrored-sheet-mixin) &key port)
   (when (sheet-direct-mirror sheet)
     (unless port
       (update-mirror-region (port sheet) sheet))))
 
 
+(defmethod note-sheet-transformation-changed :after ((sheet mirrored-sheet-mixin) &key port)
+  (when (sheet-direct-mirror sheet)
+    (unless port
+      (update-mirror-region (port sheet) sheet))))
+
+
 
 ;;; There is some confusion here about mirror-inside-edges*
 ;;; This actual returns coordinates in the mirrors parents space
 ;;; rather than
 
 (defmethod update-mirror-region ((port port) (sheet mirrored-sheet-mixin))
+  ;; If the sheet-region is changed this updates the mirrors region accordingly
   (multiple-value-bind
       ;; Coordinates in parent space
       (target-left target-top target-right target-bottom)
@@ -204,6 +217,8 @@
   (update-mirror-transformation port sheet))
 
 (defmethod update-mirror-transformation ((port port) (sheet mirrored-sheet-mixin))
+  ;; Compute transformation from sheet-region to mirror cordinates. I
+  ;; would imagine that a lot of the time this would be identity
   (multiple-value-bind
       (mirror-left mirror-top mirror-right mirror-bottom)
       (mirror-inside-edges* port sheet)
@@ -217,9 +232,7 @@
 		    (- bottom top))))
        (when (or (/= sc-x 1.0)
 		 (/= sc-y 1.0))
-	 (print (list tr-x tr-y sc-x sc-y) 
-		excl:*initial-terminal-io*)
-	 (warn "mirror scalling ~S" sheet))
+	 (warn "mirror scalling ~S, ~S" (list tr-x tr-y sc-x sc-y) sheet))
        (setf (sheet-native-transformation sheet)
 	     (compose-transformations
 	      (make-translation-transformation tr-x tr-y)
diff --git a/silica/pkg.lisp b/silica/pkg.lisp
index eb0f1fa4e11dc9f4ab95704120271e6aab31d6df..2d039ba4af17aaa5b159860a173a9dfc3e8ab322 100644
--- a/silica/pkg.lisp
+++ b/silica/pkg.lisp
@@ -236,6 +236,8 @@
    #:medium-merged-text-style-valid
    #:beep
    #:port-beep
+   #:port-server-path
+   #:change-space-req
    ))
 
 
diff --git a/silica/port.lisp b/silica/port.lisp
index ee4eafdf26ba0f197b38fce29942ead8b49ad43b..4df37f276824f409ee9005efde3761e96fb96aac 100644
--- a/silica/port.lisp
+++ b/silica/port.lisp
@@ -21,7 +21,7 @@
 
 ;; Ports and grafts
 
-(defvar *default-server-path* '(:motif :display "localhost"))
+(defvar *default-server-path* '(:motif :display "localhost:0"))
 (defvar *ports* nil)
 (defvar *port-type-mapping* nil)
 
diff --git a/silica/sheet.lisp b/silica/sheet.lisp
index aafe8569259ca17317a0d7d81534c1086d749786..2dd6cccab3223e6c40fe9c15241aee272f6ca9c1 100644
--- a/silica/sheet.lisp
+++ b/silica/sheet.lisp
@@ -31,6 +31,11 @@
 (defgeneric sheet-child (sheet)
   )
 
+(defmethod sheet-child (sheet)
+  (let ((x (sheet-children sheet)))
+    (unless (and x (null (cdr x)))
+      (error "Not one child:~S" sheet))
+    (car x)))
 (defgeneric adopt-child (sheet child)
   )
 
@@ -269,13 +274,17 @@
 		 (sheet-engrafted-p parent)))))
 
 
+(warn "Is this right?")
+
 (defmethod note-sheet-region-changed :after (sheet &key port)
   (declare (ignore port))
-  (invalidate-cached-regions sheet))
+  (unless port
+    (invalidate-cached-regions sheet)))
 
 (defmethod note-sheet-transformation-changed :after (sheet &key port)
   (declare (ignore port))
-  (invalidate-cached-transformations sheet))
+  (unless port
+    (invalidate-cached-transformations sheet)))
 
 
 
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 4b411c7316f1d0b3934df4229a0be7897f1a8f58..2380ea812bfb7d54aa69afdda16e3f6ea163dc3c 100644
--- a/test/test-suite.lisp
+++ b/test/test-suite.lisp
@@ -1,8 +1,8 @@
-;;; -*- Syntax: Common-Lisp; Base: 10; Package: CLIM-USER; Mode: LISP; Lowercase: T -*-
+;;; -*- Syntax: Common-Lisp; Base: 10; Package: CLIM; Mode: LISP; Lowercase: T -*-
 
-;; $fiHeader: test-suite.lisp,v 1.21 91/09/24 21:07:06 cer Exp $
+;; $fiHeader: test-suite.cl,v 1.1 91/12/10 16:57:32 cer Exp Locker: cer $
 
-(in-package :clim-user)
+(in-package :clim)
 
 #|
 To do:
@@ -33,6 +33,8 @@ What about environment issue?
        #-excl (declare (ignore ,i))
        ,@body)))
 
+(defun get-frame-pane (x y) (slot-value x y))
+
 (defun find-pane-named (pane-name)
   #-Silica (get-frame-pane *application-frame* pane-name)
   #+Silica (slot-value *frame* pane-name))
@@ -171,8 +173,7 @@ What about environment issue?
 
 ;; Try to get millimeters
 (defun window-mm-transformation (window)
-  (with-bounding-rectangle* (wl wt wr wb) #-Silica (window-viewport window)
-					  #+Silica (sheet-region window)
+  (with-bounding-rectangle* (wl wt wr wb) (sheet-region window)
     (make-transformation 3.4 0 0 -3.4 (floor (- wr wl) 2) (floor (- wb wt) 2))))
 
 (defmacro with-mm-transformation ((window -x -y +x +y) &body body)
@@ -180,8 +181,7 @@ What about environment issue?
      (with-drawing-options (,window :transformation transform)
        (with-bounding-rectangle* (,-x ,-y ,+x ,+y)
 				 (untransform-region transform
-						     #-Silica (window-viewport ,window)
-						     #+Silica (bounding-rectangle
+						     (bounding-rectangle
 								(sheet-region ,window)))
 	 ,@body))))
 
@@ -2830,6 +2830,7 @@ Luke Luck licks the lakes Luke's duck likes."))
 
 
 #-Silica
+#+ignore
 (define-application-frame clim-tests ()
     ()
   (:command-table (clim-tests
@@ -2862,6 +2863,40 @@ Luke Luck licks the lakes Luke's duck likes."))
 	       (caption-pane 1/10)
 	       (display-pane :rest))))))
 
+
+(define-application-frame clim-tests ()
+  (caption-pane display-pane)
+  (:command-table (clim-tests
+		   :inherit-from (graphics
+				  output-recording
+				  formatted-output
+				  redisplay
+				  presentations
+				  menus-and-dialogs
+				  benchmarks)
+		   :menu (("Graphics" :menu graphics)
+			  ("Output Recording" :menu output-recording)
+			  ("Formatted Output" :menu formatted-output)
+			  ("Redisplay" :menu redisplay)
+			  ("Presentations" :menu presentations)
+			  ("Menus and Dialogs" :menu menus-and-dialogs)
+			  ("Benchmarks" :menu benchmarks)
+			  ("Exit" :command (exit-clim-tests)))))
+  (:command-definer nil)
+  (:pane (with-slots (caption-pane display-pane) *application-frame*
+	     (silica::vertically ()
+				 (silica::scrolling
+				  ()
+				  (setf caption-pane
+				    (silica::realize-pane
+				     'application-pane)))
+				 (silica::scrolling
+				  ()
+				  (setf display-pane
+				    (silica::realize-pane
+				     'application-pane)))))))
+
+
 #-Silica
 (defmethod frame-standard-output ((frame clim-tests))
   (get-frame-pane frame 'display-pane))
diff --git a/test/test.lisp b/test/test.lisp
index 28f1ff8934190f12a076998bd10c15c898a543a7..e5b95562f8a4e17de6364c2c0c79a45ba78825f4 100644
--- a/test/test.lisp
+++ b/test/test.lisp
@@ -31,6 +31,55 @@
 					   'interactor-pane)))
 				       (realize-pane 'slider))))
 
+(define-application-frame test-frame2 ()
+  (a b c)
+  (:command-table test-frame)
+  (:pane 
+   (vertically ()
+	       (silica::tabling ()
+				(
+				 (silica::horizontally
+				  ()
+				  (realize-pane 'silica::toggle-button)
+				  (realize-pane 'silica::toggle-button)
+				  (realize-pane 'silica::toggle-button))
+		     
+				 (realize-pane 'silica::text-field))
+				(
+				 (realize-pane 'silica::push-button :label "hello")
+				 (realize-pane 'slider)))
+	       (silica::scrolling
+		()
+		(silica::realize-pane
+		   'interactor-pane
+		   :display-function 'moby-display-function))
+	       (silica::scrolling
+		()
+		(setq aaa
+		  (silica::realize-pane
+		   'interactor-pane
+		   :width 100))))))
+
+(defun moby-display-function (frame stream)
+  (window-clear stream)
+  (display-command-table-menu 
+   (frame-command-table frame)
+   stream
+   :max-width (bounding-rectangle-width stream)))
+
+(define-application-frame test-frame3 ()
+  (a b c)
+  (:command-table test-frame)
+  (:pane 
+   (silica::scrolling
+		      ()
+		      (setq aaa
+			(silica::realize-pane
+			 'interactor-pane
+			 :width 300
+			 :height 300)))))
+
+
 
 (define-test-frame-command (com-square-it :name t :menu t)
 			   ((x 'integer))
@@ -38,13 +87,30 @@
 				    *query-io*))
 
 
+(define-test-frame-command (com-double-it :name t :menu t)
+			   ((x 'integer))
+			   (present (+ x x) 'integer :stream
+				    *query-io*))
+
+
 (define-test-frame-command (com-clear :name t :menu t)
 			   ()
 			   (window-clear *query-io*))
 
 (define-test-frame-command (com-quit :name t :menu t)
 			   ()
-			   (frame-exit *application-frame*))
+  (frame-exit *application-frame*))
+
+(define-test-frame-command (com-make-table :name t :menu t)
+    ()
+  (formatting-table (*query-io*)
+		    (dotimes (i 10)
+		      (formatting-row (*query-io*)
+				      (dotimes (j 10)
+					(formatting-cell (*query-io*)
+							 (present (* i j) 'integer :stream *query-io*)))))))
+	
+					    
 
 
 (define-test-frame-command (com-show :name t :menu t)
@@ -61,3 +127,10 @@
 					   
 					   (object)
 					   (list object))
+
+
+(define-presentation-to-command-translator double-int (integer
+						       com-double-it test-frame)
+					   
+					   (object)
+					   (list object))
diff --git a/tk/callbacks.lisp b/tk/callbacks.lisp
index e9f09eb8356e6cd62a72519da412975a1bb0672f..ffd536c2aedb84e42d5add8e3e662cf2d2bdce8f 100644
--- a/tk/callbacks.lisp
+++ b/tk/callbacks.lisp
@@ -97,7 +97,7 @@
 
 (defun convert-callback-name (x)
   (let ((z (assoc x *callback-name-alist*)))
-    (unless z (error "No such Callback: ~S" z))
+    (unless z (error "No such Callback: ~S" x))
     (values (or (third z)
 		(setf (third z) (string-to-char* (second z))))
 	    (fourth z))))
diff --git a/tk/examples.lisp b/tk/examples.lisp
index 333ee77e75cab4d514f5c20e2222b8c1d52f6373..dbf46d3717bafefd5b1ba90cc936e10ec57d9517 100644
--- a/tk/examples.lisp
+++ b/tk/examples.lisp
@@ -23,13 +23,15 @@
   (add-callback da :input-callback 'da-button-press-handler :input)
   (popup app4))
 
-(defun setup ()
+(defun setup (hostspec)
   (setq context (create-application-context))
-  (setq display (make-instance 'display :context context))
+  (setq display (make-instance 'display 
+			       :host hostspec
+			       :context context))
   (setq app (app-create-shell :display display :widget-class 'application-shell)))
 
-(defun initialize-motif-toolkit (&rest ignore)
-  (setup)
+(defun initialize-motif-toolkit (hostspec)
+  (setup hostspec)
   (values context display app))
 
 (defvar *bitmaps* (quote ("background" "25_foreground" "50_foreground" "75_foreground" 
diff --git a/tk/font.lisp b/tk/font.lisp
index e7c895c764bfc21384be85f4c43bed36316ff2c9..9f113bb2ab8aaf05825c59a2c7fa7fa439623844 100644
--- a/tk/font.lisp
+++ b/tk/font.lisp
@@ -26,6 +26,9 @@
 
 (def-c-type (xcharstruct-vector :in-foreign-space) 1 x11:xcharstruct)
 
+(defmethod font-width (font)
+  (x11::xfontstruct-max-bounds-width (object-handle font)))
+ 
 (defmethod font-ascent (font)
   (x11:xfontstruct-ascent (object-handle font)))
 
diff --git a/tk/foreign.lisp b/tk/foreign.lisp
index 857d08b1435a507b95d9eafd592351271763e71f..1cd059d31866fd2bcd1d5dd2866c3f4ac6e1a9ae 100644
--- a/tk/foreign.lisp
+++ b/tk/foreign.lisp
@@ -30,22 +30,27 @@
   (make-instance 'application-context))
 
 (defun open-display (&key (context (create-application-context))
-			  (display 0)
+			  (host nil)
 			  (name "foo")
 			  (class "Foo")
 			  (options 0)
 			  (num-options 0)
 			  (argc 0)
 			  (argv 0))
-  (with-ref-par ((argc argc))
-		(open_display (object-handle context)
-			      display 
-			      (string-to-char* name)
-			      (string-to-char* class)
-			      options 
-			      num-options
-			      argc
-			      argv)))
+  (let ((d (with-ref-par ((argc argc))
+	     (open_display (object-handle context)
+			   (if host 
+			       (string-to-char* host)
+			     0)
+			   (string-to-char* name)
+			   (string-to-char* class)
+			   options 
+			   num-options
+			   argc
+			   argv))))
+    (if (zerop d)
+	(error "cannot open the display: ~A" host)
+      d)))
 
 (defclass display ()
   ((handle :reader display-handle)
@@ -53,7 +58,8 @@
   
 
 
-(defmethod initialize-instance :after ((d display) &rest args &key display)
+(defmethod initialize-instance :after ((d display) &rest args &key
+							      host display)
   (push d (application-context-displays (slot-value d 'context)))
   (setf (slot-value d 'handle)
 	(or display
diff --git a/tk/widget.lisp b/tk/widget.lisp
index c6d0b526d77837f4ed19a539184d3fc05dc4f131..ee1c4b5b455833619ca1cb26ae34d5d52f08d7d3 100644
--- a/tk/widget.lisp
+++ b/tk/widget.lisp
@@ -92,10 +92,11 @@
 
 (defforeign 'xt_window :entry-point "_XtWindow")
 
-(defun widget-window (widget)
+(defun widget-window (widget &optional (errorp t))
   (let ((id (xt_window (object-handle widget))))
     (if (zerop id)
-	(error "Invalid window id ~D for ~S" id widget)
+	(and errorp
+	     (error "Invalid window id ~D for ~S" id widget))
       (intern-object-xid
        id
        'window 
diff --git a/utils/packages.lisp b/utils/packages.lisp
index 8984b06d1c844416be852309a63f05cfc2d3189e..c3f0dd7912965824d0170f6c818eb522713ab3b7 100644
--- a/utils/packages.lisp
+++ b/utils/packages.lisp
@@ -19,7 +19,7 @@
 ;; applicable.
 ;;
 
-;; $fiHeader: packages.lisp,v 1.1 91/08/30 13:57:48 cer Exp Locker: cer $
+;; $fiHeader: packages.lisp,v 1.1 91/11/25 10:01:42 cer Exp Locker: cer $
 
 (in-package #-ansi-90 :user #+ansi-90 :common-lisp-user)
 
@@ -774,6 +774,7 @@ Copyright (c) 1991, Franz Inc. All rights reserved
    exp
    export
    expt
+   extended-char
    fboundp
    fceiling
    ffloor