From d4345d0d7c2d51dc413216dda84bba93fbc9e47a Mon Sep 17 00:00:00 2001
From: cer <cer>
Date: Wed, 15 Apr 1992 11:49:06 +0000
Subject: [PATCH] swmmerge

---
 Makefile                                  |    7 +-
 clim/accept-values.lisp                   |  162 +-
 clim/accept.lisp                          |   13 +-
 clim/basic-translators.lisp               |   41 +-
 clim/clim-defs.lisp                       |  112 +-
 clim/command-processor.lisp               |   24 +-
 clim/command.lisp                         |   33 +-
 clim/completer.lisp                       |   63 +-
 clim/coordinate-sorted-set.lisp           |   43 +-
 clim/cursor.lisp                          |   28 +-
 clim/db-stream.lisp                       |   49 +-
 clim/dragging-output.lisp                 |   14 +-
 clim/excl-presentations.lisp              |   66 +-
 clim/frames.lisp                          |  145 +-
 clim/gadget-output.lisp                   |   83 +-
 clim/gestures.lisp                        |   92 +-
 clim/graph-formatting.lisp                |   31 +-
 clim/graphics-recording.lisp              |   90 +-
 clim/histories.lisp                       |   12 +-
 clim/incremental-redisplay.lisp           |  128 +-
 clim/input-defs.lisp                      |   41 +-
 clim/input-editor-commands.lisp           |   10 +-
 clim/input-protocol.lisp                  |   71 +-
 clim/interactive-protocol.lisp            |   40 +-
 clim/menus.lisp                           |   15 +-
 clim/output-protocol.lisp                 |  204 ++-
 clim/output-recording-protocol.lisp       | 1852 ---------------------
 clim/present.lisp                         |    6 +-
 clim/presentations.lisp                   |   16 +-
 clim/ptypes1.lisp                         |    8 +-
 clim/ptypes2.lisp                         |   26 +-
 clim/recording-defs.lisp                  |    4 +-
 clim/recording-protocol.lisp              |  316 ++--
 clim/standard-tree.lisp                   |    6 +-
 clim/standard-types.lisp                  |   42 +-
 clim/stream-class-defs.lisp               |    6 +-
 clim/stream-defprotocols.lisp             |   26 +-
 clim/surround-output.lisp                 |    4 +-
 clim/table-formatting.lisp                |  115 +-
 clim/text-formatting.lisp                 |   10 +-
 clim/text-recording.lisp                  |   84 +-
 clim/tracking-pointer.lisp                |   22 +-
 clim/window-stream.lisp                   |   11 +-
 clx/clx-frames.lisp                       |    9 +-
 clx/clx-gadgets.lisp                      |   10 +-
 clx/clx-medium.lisp                       |   19 +-
 clx/clx-mirror.lisp                       |   13 +-
 clx/clx-port.lisp                         |    7 +-
 demo/address-book.lisp                    |   72 +-
 demo/cad-demo.lisp                        |  110 +-
 demo/demo-driver.lisp                     |    6 +-
 demo/demo-prefill.lisp                    |    4 +-
 demo/graphics-demos.lisp                  |    4 +-
 demo/listener.lisp                        |   11 +-
 demo/navfun.lisp                          |   70 +-
 demo/puzzle.lisp                          |   69 +-
 demo/sysdcl.lisp                          |   15 +-
 demo/thinkadot.lisp                       |   37 +-
 genera/genera-activities.lisp             |    5 +-
 genera/genera-frames.lisp                 |    8 +-
 genera/genera-gadgets.lisp                |   10 +-
 genera/genera-medium.lisp                 |   15 +-
 genera/genera-mirror.lisp                 |   11 +-
 genera/genera-port.lisp                   |   33 +-
 misc/dev-load-1.lisp                      |   15 +-
 pre-silica/cloe-implementation.lisp       |   14 +-
 pre-silica/clx-implementation.lisp        |  106 +-
 pre-silica/default-application.lisp       |    8 +-
 pre-silica/defs-graphics-generics.lisp    |   58 +-
 pre-silica/genera-implementation.lisp     |   25 +-
 pre-silica/graphics-internals.lisp        |   10 +-
 pre-silica/postscript-implementation.lisp |  161 +-
 pre-silica/protocol-intermediaries.lisp   |   22 +-
 pre-silica/window-protocol.lisp           |  140 +-
 silica/db-border.lisp                     |   17 +-
 silica/db-box.lisp                        |    2 +-
 silica/db-button.lisp                     |   21 +-
 silica/db-layout.lisp                     |   28 +-
 silica/db-scroll.lisp                     |  275 ++-
 silica/db-slider.lisp                     |    6 +-
 silica/db-table.lisp                      |    6 +-
 silica/event.lisp                         |   16 +-
 silica/framem.lisp                        |   18 +-
 silica/gadgets.lisp                       |  148 +-
 silica/graphics.lisp                      |  246 ++-
 silica/layout.lisp                        |   85 +-
 silica/macros.lisp                        |   10 +-
 silica/mirror.lisp                        |   11 +-
 silica/pkg.lisp                           |  248 ---
 silica/port.lisp                          |   32 +-
 silica/sheet.lisp                         |   42 +-
 sys/defsystem.lisp                        |    7 +-
 sys/sysdcl.lisp                           |   23 +-
 test/test-suite.lisp                      |   34 +-
 test/test.lisp                            |   15 +-
 tk-silica/ol-gadgets.lisp                 |   30 +-
 tk-silica/xm-gadgets.lisp                 |   56 +-
 tk-silica/xm-silica.lisp                  |    2 +-
 tk-silica/xt-frames.lisp                  |   59 +-
 tk-silica/xt-gadgets.lisp                 |    9 +-
 tk-silica/xt-graphics.lisp                |   43 +-
 tk-silica/xt-pixmaps.lisp                 |    5 +-
 tk-silica/xt-silica.lisp                  |  413 +++--
 tk/event.lisp                             |    5 +-
 tk/font.lisp                              |    4 +-
 tk/foreign.lisp                           |    4 +-
 tk/gcontext.lisp                          |    4 +-
 tk/graphics.lisp                          |    6 +-
 tk/make-classes.lisp                      |    7 +-
 tk/ol-examples.lisp                       |    4 +-
 tk/resources.lisp                         |   16 +-
 tk/widget.lisp                            |   26 +-
 tk/xlib.lisp                              |   23 +-
 tk/xm-classes.lisp                        |    5 +-
 utils/clim-macros.lisp                    |   10 +-
 utils/clos.lisp                           |    8 +-
 utils/coral-char-bits.lisp                |   15 +-
 utils/defun-utilities.lisp                |   43 +-
 utils/extended-regions.lisp               |   24 +-
 utils/lisp-utilities.lisp                 |  194 +--
 utils/packages.lisp                       |  263 +--
 utils/region-arithmetic.lisp              |    4 +-
 utils/regions.lisp                        |  128 +-
 utils/transformations.lisp                |   30 +-
 utils/utilities.lisp                      |   26 +-
 xlib/ffi.lisp                             |   36 +-
 xlib/xlib-defs.lisp                       |    4 +-
 xlib/xlib-funs.lisp                       |    4 +-
 128 files changed, 3064 insertions(+), 5004 deletions(-)
 delete mode 100644 clim/output-recording-protocol.lisp
 delete mode 100644 silica/pkg.lisp

diff --git a/Makefile b/Makefile
index c8f947e1..5f0537b7 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile,v 1.20 92/04/03 12:04:47 cer Exp Locker: cer $
+# $fiHeader: Makefile,v 1.21 92/04/10 14:27:40 cer Exp Locker: cer $
 # 
 #  Makefile for CLIM 2.0
 #
@@ -143,8 +143,8 @@ CLIM-STANDALONE-OBJS = clim/gestures.fasl \
                         clim/incremental-redisplay.fasl \
                         clim/coordinate-sorted-set.fasl \
                         clim/window-stream.fasl \
-                        clim/completer.fasl \
                         clim/ptypes1.fasl \
+                        clim/completer.fasl \
                         clim/presentations.fasl \
                         clim/translators.fasl \
                         clim/histories.fasl \
@@ -330,7 +330,8 @@ clim-small:	FORCE
 train	:	FORCE
 	$(ECHO) "\
 		(load \"/net/vapor/usr/tech/cer/stuff/misc/test-clim.lisp\") \
-		(clim-user::train-clim-2)" | $(CLIM) $(CLOPTS) -batch
+		(clim-user::train-clim-2) \
+		(exit 0) " | $(CLIM) $(CLOPTS) -batch
 
 # Misc
 
diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index 1210644b..af35ea63 100644
--- a/clim/accept-values.lisp
+++ b/clim/accept-values.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: accept-values.lisp,v 1.13 92/04/10 14:26:56 cer Exp Locker: cer $
+;; $fiHeader: accept-values.lisp,v 1.14 92/04/14 15:29:50 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -186,21 +186,21 @@
   (:pane 
     (with-slots (stream own-window  exit-button-stream) *application-frame*
       (vertically ()
-	 (outlining ()
-	    (scrolling (:scroll-bars :dynamic)
-		       (progn
-			 (setq stream
-			   (make-instance 'accept-values-stream
-					  :stream (setf own-window
-						    (make-pane 'clim-stream-pane
-							       :initial-cursor-visibility nil))))
-			 own-window)))
-	 (outlining ()
-	    (setf exit-button-stream
+	  (outlining ()
+	(scrolling (:scroll-bars :dynamic)
+	  (progn
+	    (setq stream
+		  (make-instance 'accept-values-stream
+				 :stream (setf own-window
+					       (make-pane 'clim-stream-pane
+							  :initial-cursor-visibility nil))))
+	    own-window)))
+	  (outlining ()
+	(setf exit-button-stream
 	      (make-pane 'clim-stream-pane
-			    :initial-cursor-visibility nil))))))
-  (:top-level (accept-values-top-level))
+			 :initial-cursor-visibility nil))))))
   (:menu-bar nil)
+  (:top-level (accept-values-top-level))
   (:command-table accept-values)
   (:command-definer nil))
 
@@ -278,8 +278,8 @@
 	 (bottom-margin 10))
      (if own-window
 	 (let ((frame (make-application-frame (or frame-class 'accept-values-own-window)
-					      :parent *application-frame*
 					      :calling-frame *application-frame*
+					      :parent *application-frame*
 					      :continuation continuation
 					      :exit-boxes exit-boxes
 					      :own-window the-own-window
@@ -525,8 +525,8 @@
       (multiple-value-bind (xoff yoff)
 	  (convert-from-relative-to-absolute-coordinates
 	    stream (output-record-parent presentation))
-	(multiple-value-bind (x y) (output-record-position* presentation)
-	  (stream-set-cursor-position* stream (+ x xoff) (+ y yoff))))
+	(multiple-value-bind (x y) (output-record-position presentation)
+	  (stream-set-cursor-position stream (+ x xoff) (+ y yoff))))
       (erase-output-record presentation stream)
       (catch-abort-gestures ("Abort editing the current field")
 	(let ((new-value nil)
@@ -806,7 +806,7 @@
       ;; :X-SPACING makes it not spread the choices to fill the whole width.
       ;; :INITIAL-SPACING NIL makes it not add whitespace at the start of the field.
       (formatting-item-list (stream :max-width (- (stream-text-margin stream)
-						  (stream-cursor-position* stream))
+						  (stream-cursor-position stream))
 				    :x-spacing '(2 :character)
 				    :initial-spacing nil)
 	(doseq (object sequence)
@@ -1041,30 +1041,22 @@
 	 (formatting-cell (stream)
 	  (with-output-as-gadget (stream)
 	    (make-pane 'push-button
-			  :activate-callback
-			  #'(lambda (gadget)
-			      (declare (ignore gadget))
-			      (com-abort-avv))
-			  :client frame
-			  :id :abort
-			  :label abort)))
+		       :label abort
+		       :client frame :id :abort
+		       :activate-callback
+		         #'(lambda (gadget)
+			     (declare (ignore gadget))
+			     (com-abort-avv)))))
 	 (formatting-cell (stream)
 	  (with-output-as-gadget (stream)
 	    (make-pane 'push-button
-			  :activate-callback
-			  #'(lambda (gadget)
-			      (declare (ignore gadget))
-			      (com-exit-avv))
-			  :client frame
-			  :id :exit
-			  :label exit))))))))
-
-;; Callback for exit boxes
-#+ignore
-(defmethod activate-callback ((button push-button) (client accept-values) id)
-  (ecase id
-    (:abort (com-abort-avv))
-    (:exit (com-exit-avv))))
+		       :label exit
+		       :client frame :id :exit
+		       :activate-callback
+		         #'(lambda (gadget)
+			    (declare (ignore gadget))
+			    (com-exit-avv))))))))))
+
 
 ;; It's OK that this is only in the ACCEPT-VALUES command table because
 ;; we're going to execute it manually in the callbacks below
@@ -1075,25 +1067,6 @@
     (setf value new-value
 	  changed-p t)))
 
-#+ignore
-(defmethod value-changed-callback :around ((gadget value-gadget)
-					   (client accept-values-stream) id new-value)
-  (declare (ignore new-value))
-  (when (accept-values-query-valid-p (accept-values-query-presentation id))
-    ;; Only call the callback if the query is still valid
-    (call-next-method)))
-
-#+ignore
-(defmethod value-changed-callback ((gadget value-gadget)
-				   (client accept-values-stream) id new-value)
-  (do-avv-command new-value client id))
-
-#+ignore
-(defmethod value-changed-callback ((gadget radio-box)
-				   (client accept-values-stream) id new-value)
-  (do-avv-command (gadget-id new-value) client id))
-
-
 (defun accept-values-value-changed-callback (gadget new-value stream query-id)
   (declare (ignore gadget))
   (when (accept-values-query-valid-p (accept-values-query-presentation query-id))
@@ -1104,8 +1077,6 @@
   ;; We attach a callback function directly now
   `(,#'accept-values-value-changed-callback ,stream ,query-id))
 
-;;;;;;;;;;;;;;;
-
 (defun do-avv-command (new-value client id)
   (throw-highlighted-presentation
    (make-instance 'standard-presentation
@@ -1122,58 +1093,39 @@
 
 ;; This is how we associate an output-record with the button
 (defmethod invoke-accept-values-command-button
-    (stream continuation (view gadget-dialog-view) prompt
-     &key (documentation (if (stringp prompt)
-			     prompt
-			   (with-output-to-string (stream)
-			     (funcall prompt stream))))
-	  (query-identifier (list ':button documentation))
-	  (cache-value t) (cache-test #'eql)
-	  resynchronize)
+    	   (stream continuation (view gadget-dialog-view) prompt
+	    &key (documentation (if (stringp prompt)
+				    prompt
+				    (with-output-to-string (stream)
+				      (funcall prompt stream))))
+		 (query-identifier (list ':button documentation))
+		 (cache-value t) (cache-test #'eql)
+		 resynchronize)
   (declare (dynamic-extent prompt))
   (updating-output 
    (stream :unique-id query-identifier :id-test #'equal
 	   :cache-value cache-value :cache-test cache-test)
    (with-output-as-gadget (stream)
-     (let ((id (stream-current-output-record (slot-value stream
-							 'stream)))
+     (let ((id (stream-current-output-record (slot-value stream 'stream)))
 	   (client (make-instance 'accept-values-command-button
 				  :continuation continuation
 				  :documentation documentation
 				  :resynchronize resynchronize)))
        (make-pane 'push-button
-		     :activate-callback
-		     #'(lambda (button)
-			 (when (accept-values-query-valid-p id)
-			   (throw-highlighted-presentation
-			    (make-instance 'standard-presentation
-					   :object `(com-avv-command-button ,client ,id)
-					   :type 'command)
-			    *input-context*
-			    ;;--- It would be nice if we had the real event...
-			    (make-instance 'pointer-button-press-event
-					   :sheet (sheet-parent button)
-					   :x 0
-					   :y 0
-					   :modifiers 0
-					   :button 256))))
-		     :label prompt
-		     :id id
-		     :client client)))))
-
-#+ignore
-(defmethod activate-callback ((button push-button)
-			      (client accept-values-command-button) id)
-  (when (accept-values-query-valid-p id)
-    (throw-highlighted-presentation
-      (make-instance 'standard-presentation
-		     :object `(com-avv-command-button ,client ,id)
-		     :type 'command)
-      *input-context*
-      ;;--- It would be nice if we had the real event...
-      (make-instance 'pointer-button-press-event
-		     :sheet (sheet-parent button)
-		     :x 0
-		     :y 0
-		     :modifiers 0
-		     :button 256))))
+		  :label prompt
+		  :id id :client client
+		  :activate-callback
+		    #'(lambda (button)
+		        (when (accept-values-query-valid-p id)
+			      (throw-highlighted-presentation
+				(make-instance 'standard-presentation
+					       :object `(com-avv-command-button ,client ,id)
+					       :type 'command)
+				*input-context*
+				;;--- It would be nice if we had the real event...
+				(make-instance 'pointer-button-press-event
+					       :sheet (sheet-parent button)
+					       :x 0
+					       :y 0
+					       :modifiers 0
+					       :button +pointer-left-button+)))))))))
diff --git a/clim/accept.lisp b/clim/accept.lisp
index 3045941a..53ce7885 100644
--- a/clim/accept.lisp
+++ b/clim/accept.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: accept.lisp,v 1.4 92/03/04 16:21:07 cer Exp $
+;; $fiHeader: accept.lisp,v 1.5 92/03/10 10:12:15 cer Exp $
 
 (in-package :clim-internals)
 
@@ -222,13 +222,13 @@
 					    (make-presentation-history-element
 					      :object default :type default-type)))
 				      (with-default-bound-in-history history default-element
-					(call-presentation-generic-function accept
+					(funcall-presentation-generic-function accept
 					  type stream view
 					  :default default :default-type default-type)))
-				    (call-presentation-generic-function accept
+				    (funcall-presentation-generic-function accept
 				      type stream view
 				      :default default :default-type default-type))
-			        (call-presentation-generic-function accept
+			        (funcall-presentation-generic-function accept
 				  type stream view)))))))))
 
 	       ;; A presentation translator was invoked
@@ -351,10 +351,11 @@
 				   (return-from accept-from-string
 				     (values default default-type index)))))))
 	    (if default-supplied-p
-		(call-presentation-generic-function accept
+		(funcall-presentation-generic-function accept
 		  type stream view
 		  :default default :default-type default-type)
-	        (call-presentation-generic-function accept type stream view))))
+	        (funcall-presentation-generic-function accept
+		  type stream view))))
       (values the-object (or the-type type) index))))
 
 ;; Make ACCEPT work inside WITH-INPUT-FROM-STRING
diff --git a/clim/basic-translators.lisp b/clim/basic-translators.lisp
index ac08745e..15532910 100644
--- a/clim/basic-translators.lisp
+++ b/clim/basic-translators.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: basic-translators.lisp,v 1.3 92/02/24 13:06:55 cer Exp $
+;; $fiHeader: basic-translators.lisp,v 1.4 92/03/04 16:21:08 cer Exp $
 
 (in-package :clim-internals)
 
@@ -153,3 +153,42 @@
     (with-presentation-type-parameters (input-editor context-type)
       (history-replace-input history stream element)
       (queue-rescan stream ':activation))))
+
+
+;; Display a menu of completions
+(define-presentation-action menu-of-completions
+    (blank-area completer global-command-table
+     :gesture :menu
+     :documentation "Menu of completions")
+    (context-type window)
+  (with-presentation-type-parameters (completer context-type)
+    (multiple-value-bind (string success object nmatches possibilities)
+	(funcall function prefix :possibilities)
+      (declare (ignore string object success))
+      (unless (or (= nmatches 0) (null possibilities))
+	;;--- Just using the first non-COMPLETER context type is far too simplistic
+	(let ((type (evacuate-list
+		      (input-context-type (second *input-context*)))))
+	  (labels ((print-possibility (possibility stream)
+		     (cond (possibility-printer
+			    (funcall possibility-printer possibility type stream))
+			   (type
+			    (present (second possibility) type :stream stream))
+			   (t
+			    (format stream "~A" (first possibility)))))
+		   (menu-choose-body (stream presentation-type)
+		     (declare (ignore presentation-type))
+		     (formatting-table (stream :multiple-columns t)
+		       (dolist (possibility possibilities)
+			 (formatting-row (stream)
+			   (formatting-cell (stream)
+			     (print-possibility possibility stream)))))))
+	    (declare (dynamic-extent #'print-possibility #'menu-choose-body))
+	    (with-menu (menu window)
+	      #-Silica (setf (window-label menu) "Menu of completions")
+	      (with-end-of-line-action (menu :allow)
+		(let ((object
+			(menu-choose-from-drawer menu type #'menu-choose-body)))
+		  (when object
+		    (presentation-replace-input stream object type +textual-view+
+						:buffer-start location :rescan t)))))))))))
diff --git a/clim/clim-defs.lisp b/clim/clim-defs.lisp
index ebd45ead..53a5cefe 100644
--- a/clim/clim-defs.lisp
+++ b/clim/clim-defs.lisp
@@ -1,69 +1,43 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clim-defs.lisp,v 1.5 92/01/31 14:57:36 cer Exp $
+;; $fiHeader: clim-defs.lisp,v 1.6 92/02/24 13:06:56 cer Exp $
 
 (in-package :clim-internals)
 
 "Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved.
  Portions copyright (c) 1988, 1989, 1990 International Lisp Associates."
 
-(defun-inline position-translate (point dx dy)
-  (values (+ (point-x point) dx)
-	  (+ (point-y point) dy)))
-
-(defun-inline position-translate* (x y dx dy)
-  (values (+ x dx)
-	  (+ y dy)))
-
-(defmacro translate-positions (x-delta y-delta &body coordinate-pairs)
+;; POSITIONS is a list of pairs of numbers.
+;; No assumptions are made about the types of the numbers.
+(defmacro translate-positions (x-delta y-delta &body positions)
   (once-only (x-delta y-delta)
     `(progn
        ,@(let ((forms nil))
-	   (dorest (pts coordinate-pairs cddr)
+	   (dorest (pts positions cddr)
 	     (push `(incf ,(first pts)  ,x-delta) forms)
 	     (push `(incf ,(second pts) ,y-delta) forms))
 	   (nreverse forms)))))
 
-#-Silica
-;;--- Use COORDINATEs here...
-(defmacro translate-fixnum-positions (x-delta y-delta &body coordinate-pairs)
-  (once-only (x-delta y-delta)
-    `(progn
-       ,@(let ((forms nil))
-	   (dorest (pts coordinate-pairs cddr)
-	     (push `(setf ,(first pts)  (the fixnum (+ ,(first pts)  ,x-delta))) forms)
-	     (push `(setf ,(second pts) (the fixnum (+ ,(second pts) ,y-delta))) forms))
-	   (nreverse forms)))))
-
-#+Silica
-(defmacro translate-fixnum-positions (x-delta y-delta &body coordinate-pairs)
-  (once-only (x-delta y-delta)
-    `(progn
-       ,@(let ((forms nil))
-	   (dorest (pts coordinate-pairs cddr)
-	     (push `(setf ,(first pts)  (+ ,(first pts)  ,x-delta)) forms)
-	     (push `(setf ,(second pts) (+ ,(second pts) ,y-delta)) forms))
-	   (nreverse forms)))))
-
-(defun translate-point-sequence (x-delta y-delta points)
-  (let ((new-points (make-list (length points))))
-    (do ((coords points (cddr coords))
-	 (new-coords new-points (cddr new-coords)))
-	((null coords))
-      (let ((x (first coords))
-	    (y (second coords)))
+(defun translate-position-sequence (x-delta y-delta positions)
+  (let ((new-positions (make-list (length positions))))
+    (do ((positions positions (cddr positions))
+	 (new-positions new-positions (cddr new-positions)))
+	((null positions))
+      (let ((x (first positions))
+	    (y (second positions)))
 	(translate-positions x-delta y-delta x y)
-	(setf (first new-coords) x)
-	(setf (second new-coords) y)))
-    new-points))
+	(setf (first new-positions) x)
+	(setf (second new-positions) y)))
+    new-positions))
 
 ;; Destructive version of the above
-(defun ntranslate-point-sequence (x-delta y-delta points)
-  (do ((coords points (cddr coords)))
-      ((null coords))
-    (translate-positions x-delta y-delta (first coords) (second coords)))
-  points)
+(defun ntranslate-position-sequence (x-delta y-delta positions)
+  (do ((positions positions (cddr positions)))
+      ((null positions))
+    (translate-positions x-delta y-delta (first positions) (second positions)))
+  positions)
 
+
 (defclass io-buffer
 	  ()
      ((size :accessor io-buffer-size :initarg :size)
@@ -102,10 +76,10 @@
 (defmacro with-stream-cursor-position-saved ((stream) &body body)
   (let ((x '#:x)
 	(y '#:y))
-    `(multiple-value-bind (,x ,y) (stream-cursor-position* ,stream)
+    `(multiple-value-bind (,x ,y) (stream-cursor-position ,stream)
        (unwind-protect
 	   (progn ,@body)
-	 (stream-set-cursor-position* ,stream ,x ,y)))))
+	 (stream-set-cursor-position ,stream ,x ,y)))))
 
 (defmacro with-output-recording-options 
 	  ((stream &key (draw nil draw-supplied)
@@ -267,6 +241,46 @@
 	 (when ,old-input-focus
 	   (stream-restore-input-focus ,stream ,old-input-focus))))))
 
+
+(defmacro completing-from-suggestions ((stream &rest options) &body body)
+  (declare (arglist (stream &key partial-completers allow-any-input possibility-printer)
+		    &body body))
+  (declare (values object success string nmatches))
+  #+Genera (declare (zwei:indentation 0 3 1 1))
+  (let ((string '#:string)
+	(action '#:action))
+    `(flet ((completing-from-suggestions-body (,string ,action)
+	      (suggestion-completer (,string :action ,action
+				     ,@(remove-keywords options '(:allow-any-input
+							       :possibility-printer)))
+		,@body)))
+       (declare (dynamic-extent #'completing-from-suggestions-body))
+       (complete-input ,stream #'completing-from-suggestions-body ,@options))))
+
+;; The second argument to the generator function is a function to be
+;; called on a string (and object and presentation type) to suggest
+;; that string.
+(defmacro suggestion-completer ((string &key action partial-completers) &body body)
+  #+Genera (declare (zwei:indentation 0 3 1 1))
+  (let ((function '#:function))
+    `(flet ((suggestion-completer-body (,string ,function)
+	      (declare (ignore ,string))
+	      (flet ((suggest (&rest args)
+		       (declare (dynamic-extent args))
+		       (apply ,function args)))
+		nil		;workaround broken compilers
+		,@body)))
+       (declare (dynamic-extent #'suggestion-completer-body))
+       (complete-from-generator ,string #'suggestion-completer-body
+				,partial-completers :action ,action))))
+
+;; Very few lisp compilers seem to be able to handle the case where this top-level
+;; macro is shadowed by the FLET in the continuation above.
+#+Genera
+(defmacro suggest (name &rest objects)
+  (declare (ignore name objects))
+  (error "You cannot use ~S outside of ~S" 'suggest 'completing-from-suggestions))
+
 
 ;;; From MENUS.LISP
 ;;; For now, MENU-CHOOSE requires that you pass in a parent.
diff --git a/clim/command-processor.lisp b/clim/command-processor.lisp
index 38910527..b9fffe54 100644
--- a/clim/command-processor.lisp
+++ b/clim/command-processor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: command-processor.lisp,v 1.5 92/03/10 10:12:20 cer Exp Locker: cer $
+;; $fiHeader: command-processor.lisp,v 1.6 92/03/24 19:37:45 cer Exp $
 
 (in-package :clim-internals)
 
@@ -46,11 +46,10 @@
 	   (with-accept-help ((:top-level-help #'command-help))
 	     (multiple-value-bind (command final-delimiter)
 		 (invoke-command-name-parser-and-collect-1 
-		  command-name arg-parser delimiter-parser stream)
-	       ;;-- In the cad demo this ends up as NIL. Is that ok??
+		   command-name arg-parser delimiter-parser stream)
 	       (if (and final-delimiter
 			(member final-delimiter *command-previewers*
-			   :test #'keyboard-event-matches-gesture-name-p))
+				:test #'keyboard-event-matches-gesture-name-p))
 		   (with-input-editor-typeout (stream)
 		     (accept-values-command-parser
 		       command-name command-table 
@@ -126,8 +125,8 @@
 	     (write-string (first possibility) stream)
 	     (let ((documentation (assoc (second possibility) keyword-documentation)))
 	       (when documentation
-		 (multiple-value-bind (x y) (stream-cursor-position* stream)
-		   (stream-set-cursor-position* stream (max 200 (+ x 20)) y)
+		 (multiple-value-bind (x y) (stream-cursor-position stream)
+		   (stream-set-cursor-position stream (max 200 (+ x 20)) y)
 		   (write-string (second documentation) stream)))))))
     (declare (dynamic-extent #'print-keyword))
     (values (completing-from-suggestions (stream :possibility-printer #'print-keyword)
@@ -396,7 +395,6 @@
 				   (let ((command 
 					   (lookup-keystroke-command-item
 					     keystroke command-table
-					     :test #'keyboard-event-matches-gesture-name-p
 					     :numeric-argument numeric-arg)))
 				     (when (presentation-typep command command-type)
 				       (return-from menu-command-parser
@@ -669,16 +667,14 @@
 			  (command-parser *command-parser*)
 			  (command-unparser *command-unparser*)
 			  (partial-command-parser *partial-command-parser*)
-			  (use-keystrokes nil)
-			  (keystroke-test #'keyboard-event-matches-gesture-name-p))
+			  (use-keystrokes nil))
   (if use-keystrokes
       (with-command-table-keystrokes (keystrokes command-table)
 	(read-command-using-keystrokes command-table keystrokes
 				       :stream stream
 				       :command-parser command-parser
 				       :command-unparser command-unparser
-				       :partial-command-parser partial-command-parser
-				       :keystroke-test keystroke-test))
+				       :partial-command-parser partial-command-parser))
       (let ((*command-parser* command-parser)
 	    (*command-unparser* command-unparser)
 	    (*partial-command-parser* partial-command-parser))
@@ -691,8 +687,7 @@
 				      &key (stream *query-io*)
 					   (command-parser *command-parser*)
 					   (command-unparser *command-unparser*)
-					   (partial-command-parser *partial-command-parser*)
-					   (keystroke-test #'keyboard-event-matches-gesture-name-p))
+					   (partial-command-parser *partial-command-parser*))
   (let ((*command-parser* command-parser)
 	(*command-unparser* command-unparser)
 	(*partial-command-parser* partial-command-parser))
@@ -710,7 +705,6 @@
 		      :stream stream :prompt nil))))
       (if (keyboard-event-p command)
 	  (let ((command (lookup-keystroke-command-item command command-table
-							:test keystroke-test
 							:numeric-argument numeric-arg)))
 	    (if (partial-command-p command)
 		(funcall *partial-command-parser*
@@ -802,7 +796,7 @@
 	(with-stack-list (type 'command-name ':command-table command-table)
 	  ;; Use a lower level function for speed
 	  (return-from document-presentation-to-command-translator
-	    (call-presentation-generic-function present
+	    (funcall-presentation-generic-function present
 	      command-name type stream +textual-view+))))))
   (format stream "Command translator ~S" (presentation-translator-name translator))
   (values))
diff --git a/clim/command.lisp b/clim/command.lisp
index 2e41a621..de9983f1 100644
--- a/clim/command.lisp
+++ b/clim/command.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: command.lisp,v 1.5 92/03/06 09:08:41 cer Exp $
+;; $fiHeader: command.lisp,v 1.6 92/03/10 10:12:22 cer Exp $
 
 (in-package :clim-internals)
 
@@ -195,7 +195,7 @@
     (nstring-capitalize (nsubstitute #\Space #\- name))))
 
 (defun add-command-to-command-table (command-name command-table
-				     &key name menu keystroke (test #'gesture-eql) (errorp t))
+				     &key name menu keystroke (errorp t))
   (check-type command-name symbol)
   (setq command-table (find-command-table command-table))
   (when (eq name t)
@@ -230,7 +230,7 @@
 		    menu-options))
 	    (keystroke
 	     (add-keystroke-to-command-table command-table keystroke ':command command-name
-					     :test test :errorp errorp)))))
+					     :errorp errorp)))))
   command-name)
 
 (defun remove-command-from-command-table (command-name command-table &key (errorp t))
@@ -400,7 +400,10 @@
   (check-type type (member :command :function :menu :divider))
   (when keystroke
     (assert (keyboard-gesture-spec-p keystroke) (keystroke)
-	    "~S is not a keyboard gesture spec" keystroke))
+	    "~S is not a keyboard gesture spec" keystroke)
+    (multiple-value-bind (keysym modifiers)
+	(decode-gesture-spec keystroke)
+      (setq keystroke (cons keysym modifiers))))
   (check-type documentation (or string null))
   (setq command-table (find-command-table command-table))
   (let ((old-item (and string (find-menu-item string command-table :errorp nil))))
@@ -674,30 +677,29 @@
 ;;; Keystroke accelerators
 
 (defun add-keystroke-to-command-table (command-table keystroke type value
-				       &key documentation (test #'gesture-eql) (errorp t))
+				       &key documentation (errorp t))
   (assert (keyboard-gesture-spec-p keystroke) (keystroke)
 	  "~S is not a keyboard gesture spec" keystroke)
   (check-type type (member :command :function :menu))
   (check-type documentation (or string null))
   (setq command-table (find-command-table command-table))
   (let ((old-item (find-keystroke-item keystroke command-table
-				       :test test :errorp nil)))
+				       :test #'gesture-spec-eql :errorp nil)))
     (when old-item
       (when errorp
 	(cerror "Remove the keystroke item and proceed"
 		'command-already-present
 		:format-string "Keystroke item ~S already present in ~S"
 		:format-args (list keystroke command-table)))
-	(remove-keystroke-from-command-table command-table keystroke :test test)))
+	(remove-keystroke-from-command-table command-table keystroke)))
   (add-menu-item-to-command-table command-table nil type value
 				  :documentation documentation
 				  :keystroke keystroke :errorp nil))
 
-(defun remove-keystroke-from-command-table (command-table keystroke
-					    &key (test #'gesture-eql) (errorp t))
+(defun remove-keystroke-from-command-table (command-table keystroke &key (errorp t))
   (setq command-table (find-command-table command-table))
   (with-slots (menu keystrokes) command-table
-    (let ((index (position keystroke menu :key #'second :test test)))
+    (let ((index (position keystroke menu :key #'second :test #'gesture-spec-eql)))
       (cond (index
 	     (let ((element (aref menu index)))
 	       ;; Don't remove the whole item if there's a menu-name,
@@ -722,11 +724,12 @@
 		 (apply function entry)))
        (slot-value (find-command-table command-table) 'menu)))
 
-(defun find-keystroke-item (keystroke command-table &key (test #'gesture-eql) (errorp t))
+(defun find-keystroke-item (keystroke command-table 
+			    &key (test #'keyboard-event-matches-gesture-name-p) (errorp t))
   (declare (values menu-item command-table))
   (let* ((command-table (find-command-table command-table))
 	 (entry (block find-entry
-		  ;; Do it the hard way so that GESTURE-EQL doesn't see NILs
+		  ;; Do it the hard way so that GESTURE-SPEC-EQL doesn't see NILs
 		  (map nil #'(lambda (entry)
 			       (when (and (second entry)
 					  (funcall test keystroke (second entry)))
@@ -740,7 +743,8 @@
 	   :format-string "Keystroke ~S has no menu item present in ~S"
 	   :format-args (list keystroke command-table))))
 
-(defun lookup-keystroke-item (keystroke command-table &key (test #'gesture-eql))
+(defun lookup-keystroke-item (keystroke command-table 
+			      &key (test #'keyboard-event-matches-gesture-name-p))
   (declare (values menu-item command-table))
   (labels ((map-menu (command-table)
 	     (map nil #'(lambda (entry)
@@ -764,7 +768,8 @@
 ;; Return a command associated with a keystroke iff it is enabled.
 ;; Otherwise, return the keystroke keystroke.
 (defun lookup-keystroke-command-item (keystroke command-table
-				      &key (test #'gesture-eql) (numeric-argument 1))
+				      &key (test #'keyboard-event-matches-gesture-name-p)
+					   (numeric-argument 1))
   (let ((item (lookup-keystroke-item keystroke command-table :test test)))
     (when item
       (let* ((type (command-menu-item-type item))
diff --git a/clim/completer.lisp b/clim/completer.lisp
index b7adc522..b4307264 100644
--- a/clim/completer.lisp
+++ b/clim/completer.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: completer.lisp,v 1.4 92/03/04 16:21:17 cer Exp $
+;; $fiHeader: completer.lisp,v 1.5 92/03/10 10:12:24 cer Exp $
 
 (in-package :clim-internals)
 
@@ -23,6 +23,17 @@
 (defvar *magic-completion-gestures*
 	(append *completion-gestures* *help-gestures* *possibilities-gestures*))
 
+(define-presentation-type completer (&key stream function possibility-printer
+					  prefix location))
+
+(define-presentation-method presentation-typep (object (type completer))
+  (declare (ignore object))
+  nil)
+
+(define-presentation-method presentation-subtypep ((subtype completer) supertype)
+  (declare (ignore supertype))
+  t)
+
 (defun complete-input (stream function
 		       &key partial-completers allow-any-input possibility-printer
 			    (help-displays-possibilities t))
@@ -58,8 +69,15 @@
 	  (loop
 	    ;; Maybe these, as well as TOKEN and CH should be LET inside the loop...
 	    (setq unread nil return nil extend nil)
-	    (setq token (read-token stream))
-	    (setq ch (read-gesture :stream stream))	;don't care about wait functions
+	    (with-input-context (`(completer :stream ,stream
+					     :function ,function
+					     :possibility-printer ,possibility-printer
+					     :prefix ,stuff-so-far
+					     :location ,location)) ()
+	         (progn 
+		   (setq token (read-token stream))
+		   (setq ch (read-gesture :stream stream)))
+	      (t (beep)))
 	    (extend-vector stuff-so-far token)
 	    (cond ((null ch)
 		   (error "Null ch?"))
@@ -207,45 +225,6 @@
 			 (formatting-cell (stream)
 			   (print-possibility possibility stream)))))))))))))
 
-(defmacro completing-from-suggestions ((stream &rest options) &body body)
-  (declare (arglist (stream &key partial-completers allow-any-input possibility-printer)
-		    &body body))
-  (declare (values object success string nmatches))
-  #+Genera (declare (zwei:indentation 0 3 1 1))
-  (let ((string '#:string)
-	(action '#:action))
-    `(flet ((completing-from-suggestions-body (,string ,action)
-	      (suggestion-completer (,string :action ,action
-				     ,@(remove-keywords options '(:allow-any-input
-							       :possibility-printer)))
-		,@body)))
-       (declare (dynamic-extent #'completing-from-suggestions-body))
-       (complete-input ,stream #'completing-from-suggestions-body ,@options))))
-
-;; The second argument to the generator function is a function to be
-;; called on a string (and object and presentation type) to suggest
-;; that string.
-(defmacro suggestion-completer ((string &key action partial-completers) &body body)
-  #+Genera (declare (zwei:indentation 0 3 1 1))
-  (let ((function '#:function))
-    `(flet ((suggestion-completer-body (,string ,function)
-	      (declare (ignore ,string))
-	      (flet ((suggest (&rest args)
-		       (declare (dynamic-extent args))
-		       (apply ,function args)))
-		nil		;workaround broken compilers
-		,@body)))
-       (declare (dynamic-extent #'suggestion-completer-body))
-       (complete-from-generator ,string #'suggestion-completer-body
-				,partial-completers :action ,action))))
-
-;; Very few lisp compilers seem to be able to handle the case where this top-level
-;; macro is shadowed by the FLET in the continuation above.
-#+Genera
-(defmacro suggest (name &rest objects)
-  (declare (ignore name objects))
-  (error "You cannot use ~S outside of ~S" 'suggest 'completing-from-suggestions))
-
 (defvar *null-object* '#:null)
 
 ;; Complete STRING chunk-wise against the completion possibilities in the
diff --git a/clim/coordinate-sorted-set.lisp b/clim/coordinate-sorted-set.lisp
index 5bb414b2..4b35b237 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.2 92/02/24 13:07:10 cer Exp $
+;; $fiHeader: coordinate-sorted-set.lisp,v 1.3 92/03/04 16:21:18 cer Exp $
 
 (in-package :clim-internals)
 
@@ -19,7 +19,7 @@
 ;;;  map-over-output-records-overlapping-region:
 ;;;   (function record region
 ;;;    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
-;;;  map-over-output-records-containing-point*:
+;;;  map-over-output-records-containing-position:
 ;;;   (function record x y
 ;;;    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
 
@@ -27,7 +27,7 @@
 	  (output-record-mixin output-record-element-mixin output-record)
     ((coordinate-sorted-set)			;a simple vector, by gawd
      (fill-pointer :initform 0)
-     (tallest-box-height :initform 0)))
+     (tallest-box-height :initform (coordinate 0))))
 
 (defmethod initialize-instance :after ((record standard-tree-output-record)
 				       &key (size 200))
@@ -57,7 +57,7 @@
 
 (defmethod clear-output-record ((record standard-tree-output-record))
   (with-slots (coordinate-sorted-set fill-pointer tallest-box-height) record
-    (setf tallest-box-height 0)
+    (setf tallest-box-height (coordinate 0))
     ;; Release pointers to objects
     (fill coordinate-sorted-set nil :start 0 :end fill-pointer)
     (setf fill-pointer 0)))
@@ -67,7 +67,7 @@
     (let ((vector coordinate-sorted-set)
 	  (fp fill-pointer))
       (declare (type simple-vector vector) #+Genera (sys:array-register vector))
-      (declare (fixnum fp))
+      (declare (type fixnum fp))
       (maxf tallest-box-height (bounding-rectangle-height child))
       (with-bounding-rectangle* (left top right bottom) child
         (declare (ignore left top))
@@ -86,7 +86,7 @@
 	      (simple-vector-push-extend child vector fp 200))
 	  (let ((index (coordinate-sorted-set-index-for-position
 			 vector right bottom 0 fp)))
-	    (declare (fixnum index))
+	    (declare (type fixnum index))
 	    ;; Make sure that the new child comes after any child it overlaps
 	    ;; so that replaying happens in the right order.
 	    (loop
@@ -110,7 +110,8 @@
 		 ;; Shift the whole vector downward
 		 (do ((i (the fixnum index) (1+ i)))
 		     ((= i new-fp))
-		   (declare (fixnum i) (optimize (speed 3) (safety 0)))
+		   (declare (type fixnum i)
+			    (optimize (speed 3) (safety 0)))
 		   (setf (svref vector i) (svref vector (1+ i)))))
 	       (setf fill-pointer new-fp)
 	       t))
@@ -131,17 +132,17 @@
 	(dovector ((child index) vector :start 0 :end length :simple-p t)
 	  (apply function child continuation-args))
       (with-bounding-rectangle* (left1 top1 right1 bottom1) region
-	(translate-fixnum-positions x-offset y-offset left1 top1 right1 bottom1)
+	(translate-coordinates x-offset y-offset left1 top1 right1 bottom1)
 	(let ((start (coordinate-sorted-set-index-for-position vector 0 top1 0 length))
 	      (limit (+ bottom1 (slot-value record 'tallest-box-height))))
-	  (declare (fixnum start limit))
+	  (declare (type fixnum start limit))
 	  ;; Subtract out the record offset from the region, to make comparison fair
 	  (multiple-value-bind (xoff yoff)
-	      (output-record-position* record)
-	    (translate-fixnum-positions (- xoff) (- yoff) left1 top1 right1 bottom1))
+	      (output-record-position record)
+	    (translate-coordinates (- xoff) (- yoff) left1 top1 right1 bottom1))
 	  (do ((index start (the fixnum (1+ (the fixnum index)))))
 	      ((= (the fixnum index) length))
-	    (declare (fixnum index))
+	    (declare (type fixnum index))
 	    (let ((child (svref vector index)))
 	      (with-bounding-rectangle* (left2 top2 right2 bottom2) child
 		(when (ltrb-overlaps-ltrb-p left1 top1 right1 bottom1
@@ -150,13 +151,13 @@
 		(when (> bottom2 limit)
 		  (return nil))))))))))
 
-(defmethod map-over-output-records-containing-point*
+(defmethod map-over-output-records-containing-position
 	   (function (record standard-tree-output-record) x y
 	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
   (declare (dynamic-extent function continuation-args))
   (declare (type coordinate x-offset y-offset))
   (declare (optimize (safety 0)))
-  (translate-fixnum-positions x-offset y-offset x y)
+  (translate-coordinates x-offset y-offset x y)
   (let ((vector (slot-value record 'coordinate-sorted-set))
 	(length (slot-value record 'fill-pointer))
 	(bound (slot-value record 'tallest-box-height)))
@@ -164,16 +165,16 @@
 	     #+Genera (sys:array-register vector))
     (let ((end (coordinate-sorted-set-index-for-position vector 0 (+ y bound 1) 0 length))
 	  (limit (- y bound)))
-      (declare (fixnum end limit))
+      (declare (type fixnum end limit))
       (multiple-value-bind (xoff yoff)
-	  (output-record-position* record)
-	(translate-fixnum-positions (- xoff) (- yoff) x y))
+	  (output-record-position record)
+	(translate-coordinates (- xoff) (- yoff) x y))
       (do ((index (min (1- length) end) (the fixnum (1- (the fixnum index)))))
 	  ((< (the fixnum index) 0))
-	(declare (fixnum index))
+	(declare (type fixnum index))
 	(let ((child (svref vector index)))
 	  (with-bounding-rectangle* (left top right bottom) child
-	    (when (ltrb-contains-point*-p left top right bottom x y)
+	    (when (ltrb-contains-position-p left top right bottom x y)
 	      (apply function child continuation-args))
 	    (when (< bottom limit)
 	      (return nil))))))))
@@ -187,7 +188,7 @@
     ;; Binary search to find where this one goes.
     (let ((search-index (coordinate-sorted-set-index-for-position
 			  vector right bottom 0 fill-pointer)))
-      (declare (fixnum search-index))
+      (declare (type fixnum search-index))
       ;; Search back over things in the same place.
       (when (< search-index fill-pointer)
 	(dovector ((record index) vector :start 0 :end (1+ search-index)
@@ -215,7 +216,7 @@
   (declare (optimize (speed 3) (safety 0)))
   (let ((below start)
 	(above end))
-    (declare (fixnum below above))
+    (declare (type fixnum below above))
     (assert (<= below above))			;Binary search will loop otherwise.
     (let (#+(or Genera Minima) (vector vector))
       #+Genera (declare (sys:array-register vector))
diff --git a/clim/cursor.lisp b/clim/cursor.lisp
index 535e9ff6..7697518f 100644
--- a/clim/cursor.lisp
+++ b/clim/cursor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cursor.lisp,v 1.7 92/03/04 16:21:20 cer Exp Locker: cer $
+;; $fiHeader: cursor.lisp,v 1.8 92/04/03 12:04:32 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -30,6 +30,7 @@
 ;;; to go through to the port level, where an appropriate host-window-system thing
 ;;; may be manipulated.  Should this be unified with the mouse cursor stuff?
 
+;;--- The positions here should be a COORDINATE pair, no?
 (defclass text-cursor
 	  (cursor #+Silica region)
     ((x :initarg :x)
@@ -60,12 +61,12 @@
 (defmethod (setf cursor-stream) (new-value (cursor text-cursor))
   (setf (slot-value cursor 'stream) new-value))
 
-(defmethod cursor-position* ((cursor text-cursor))
+(defmethod cursor-position ((cursor text-cursor))
   (with-slots (x y) cursor
     (values x y)))
 
 #-Silica
-(defmethod cursor-set-position* ((cursor text-cursor) nx ny)
+(defmethod cursor-set-position ((cursor text-cursor) nx ny)
   (with-slots (x y visibility) cursor
     (unless (and (= x nx)
 		 (= y ny))
@@ -76,10 +77,20 @@
 	(draw-cursor cursor T)))))
 
 #+Silica
-(defmethod cursor-set-position* ((cursor text-cursor) nx ny)
+(defmethod cursor-set-position ((cursor text-cursor) nx ny)
   (with-slots (x y visibility) cursor
     (setf x nx y ny)))
 
+#+CLIM-1-compatibility
+(define-compatibility-function (cursor-position* cursor-position)
+			       (cursor)
+  (cursor-position cursor))
+
+#+CLIM-1-compatibility
+(define-compatibility-function (cursor-set-position* cursor-set-position)
+			       (cursor x y)
+  (cursor-set-position cursor x y))
+
 (defmethod (setf cursor-state) (new-state (cursor text-cursor))
   (multiple-value-bind (active state focus)
       (decode-cursor-flags (slot-value cursor 'flags))
@@ -206,14 +217,13 @@
 	(with-output-recording-options (stream :record nil)
 	  (draw-line-internal
 	    stream 0 0
-	    ;;--- gack
-	    (the fixnum x) (the fixnum (+ y height))
-	    (the fixnum (+ x 2)) (the fixnum (+ y height 2))
+	    (the coordinate x) (the coordinate (+ y height))
+	    (the coordinate (+ x 2)) (the coordinate (+ y height 2))
 	    (if on-p +foreground-ink+ +background-ink+) +highlighting-line-style+)
 	  (draw-line-internal
 	    stream 0 0
-	    (the fixnum x) (the fixnum (+ y height))
-	    (the fixnum (- x 2)) (the fixnum (+ y height 2))
+	    (the coordinate x) (the coordinate (+ y height))
+	    (the coordinate (- x 2)) (the coordinate (+ y height 2))
 	    (if on-p +foreground-ink+ +background-ink+) +highlighting-line-style+))
 	;; --- do we really want to do this here??
 	(force-output stream)))))
diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp
index 282f9da2..64b8a432 100644
--- a/clim/db-stream.lisp
+++ b/clim/db-stream.lisp
@@ -22,7 +22,7 @@
 ;;;
 ;;; Copyright (c) 1990 by Xerox Corporations.  All rights reserved.
 ;;;
-;; $fiHeader: db-stream.lisp,v 1.10 92/03/24 19:37:47 cer Exp Locker: cer $
+;; $fiHeader: db-stream.lisp,v 1.11 92/04/10 14:26:58 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -32,6 +32,7 @@
 ;;; CLIM stream sheets and panes
 
 ;;--- How to keep PANE-BACKGROUND/FOREGROUND in sync with the medium?
+;;--- I'm not convinced that including WINDOW-STREAM here is right...
 (defclass clim-stream-sheet 
 	  (window-stream			;includes output recording
 	   pane
@@ -193,8 +194,8 @@
 
 (defclass interactor-pane (clim-stream-pane) ())
 (defclass application-pane (clim-stream-pane) ())
-(defclass pointer-documentation-pane (clim-stream-pane) ())
 (defclass command-menu-pane (clim-stream-pane) ())
+(defclass pointer-documentation-pane (clim-stream-pane) ())
 
 (defmethod compose-space :before ((pane command-menu-pane) &key width height)
   (declare (ignore width height))
@@ -227,8 +228,8 @@
 	(setq pane `(vertically ()
 		      ,pane
 		      (make-pane 'label-pane 
-				    :text ,label
-				    :max-width +fill+))))
+				 :text ,label
+				 :max-width +fill+))))
       `(outlining (:thickness 1)
 	 ,pane))))
 
@@ -247,7 +248,7 @@
       (clear-output-history stream)
       (window-erase-viewport stream)
       (when (extended-output-stream-p stream)	;can we assume this?
-	(stream-set-cursor-position* stream 0 0)
+	(stream-set-cursor-position stream 0 0)
 	(setf (stream-baseline stream) 0
 	      (stream-current-line-height stream) 0))
       ;; Flush the old mouse position relative to this window
@@ -272,8 +273,7 @@
   (with-sheet-medium (medium stream)
     (multiple-value-call #'draw-rectangle*
       medium
-      (bounding-rectangle* (or (pane-viewport stream)
-			       stream))
+      (bounding-rectangle* (or (pane-viewport stream) stream))
       :ink +background-ink+)))
 
 (defmethod window-expose ((stream clim-stream-sheet))
@@ -294,10 +294,10 @@
 (defmethod window-viewport ((stream clim-stream-sheet))
   (pane-viewport-region stream))
 
-(defmethod window-viewport-position* ((stream clim-stream-sheet))
-  (bounding-rectangle-position* (pane-viewport-region stream)))
+(defmethod window-viewport-position ((stream clim-stream-sheet))
+  (bounding-rectangle-position (pane-viewport-region stream)))
 
-(defmethod window-set-viewport-position* ((stream clim-stream-sheet) x y)
+(defmethod window-set-viewport-position ((stream clim-stream-sheet) x y)
   (scroll-extent stream :x x :y y))
 
 (defmethod window-inside-size ((stream clim-stream-sheet))
@@ -326,20 +326,11 @@
 (defun beep (&optional (stream *standard-output*))
   (port-beep (port stream) stream))
 
-;; This is called by OUTPUT-RECORDING-MIXIN's whopper on set-viewport-position*.
+;; This is called by OUTPUT-RECORDING-MIXIN's whopper on set-viewport-position.
 ;; It shifts a region of the "host screen" that's visible to some other visible
 ;; location.  It does NOT do any cleaning up after itself.  It does not side-effect
 ;; the output history of the window.  It calls COPY-AREA whose contract is to 
 ;; do the above, the whole above, and nothing but the above.
-
-;;;---
-(defmethod window-shift-visible-region ((window t)
-					old-left old-top old-right old-bottom
-					new-left new-top new-right
-					new-bottom)
-  (declare (ignore old-left old-top old-right old-bottom new-left new-top new-right new-bottom))
-  nil)
-
 (defmethod window-shift-visible-region ((window clim-stream-sheet)
 					old-left old-top old-right old-bottom
 					new-left new-top new-right new-bottom)
@@ -372,15 +363,23 @@
 	(let ((width (- stream-width (abs delta-x)))
 	      (height (- stream-height (abs delta-y))))
 	  (multiple-value-bind (ml mt) 
-	      (values 0 0)
+	      (values (coordinate 0) (coordinate 0))
 	    (declare (type coordinate ml mt))
-	    (translate-fixnum-positions ml mt from-x from-y)
+	    (translate-coordinates ml mt from-x from-y)
 	    (let ((tf (sheet-transformation window)))
  	      (multiple-value-call #'copy-area 
 		window
-		(untransform-point* tf from-x from-y)
-		(untransform-point* tf (+ from-x width) (+ from-y height))
-		(untransform-point* tf (+ from-x delta-x) (+ from-y delta-y))))))))))
+		(untransform-position tf from-x from-y)
+		(untransform-position tf (+ from-x width) (+ from-y height))
+		(untransform-position tf (+ from-x delta-x) (+ from-y delta-y))))))))))
+
+;;;--- Why do we need this?
+(defmethod window-shift-visible-region ((window t)
+					old-left old-top old-right old-bottom
+					new-left new-top new-right new-bottom)
+  (declare (ignore old-left old-top old-right old-bottom
+		   new-left new-top new-right new-bottom))
+  nil)
 
 #+Genera
 (defgeneric stream-compatible-inside-size (window)
diff --git a/clim/dragging-output.lisp b/clim/dragging-output.lisp
index 1b7cca16..6ccbe00f 100644
--- a/clim/dragging-output.lisp
+++ b/clim/dragging-output.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: dragging-output.lisp,v 1.5 92/03/04 16:21:30 cer Exp $
+;; $fiHeader: dragging-output.lisp,v 1.6 92/03/10 10:12:32 cer Exp $
 
 (in-package :clim-internals)
 
@@ -29,14 +29,14 @@
 	;; Clipping region for repainting the damaged region
 	(region (bounding-rectangle output-record)))
     (multiple-value-bind (initial-x initial-y)
-	(stream-pointer-position* stream)
+	(stream-pointer-position stream)
       (declare (type coordinate initial-x initial-y))
       (multiple-value-bind (x-offset y-offset)
 	  (convert-from-relative-to-absolute-coordinates
 	    stream (output-record-parent output-record))
 	(declare (type coordinate x-offset y-offset))
 	(multiple-value-bind (record-x record-y)
-	    (bounding-rectangle-position* output-record)
+	    (bounding-rectangle-position output-record)
 	  ;; Deltas are the position of the mouse in the local coordinate
 	  ;; system of the record
 	  (setq delta-x (- initial-x record-x)
@@ -52,7 +52,7 @@
 		   ;; because the user can be moving the pointer really fast,
 		   ;; causing FINISH to be called on coordinates which are
 		   ;; "before" the values of LAST-X/Y.
-		   (output-record-set-position* output-record (- x delta-x) (- y delta-y))
+		   (output-record-set-position output-record (- x delta-x) (- y delta-y))
 		   (when parent
 		     (add-output-record output-record parent)
 		     (tree-recompute-extent output-record))
@@ -78,9 +78,11 @@
 		         (funcall erase output-record stream)))
 		   (setq last-x x last-y y)
 		   ;; Remember the space the record used to occupy
-		   (setq region (bounding-rectangle output-record region))
+		   (with-bounding-rectangle* (rl rt rr rb) output-record
+		     (translate-coordinates x-offset y-offset rl rt rr rb)
+		     (bounding-rectangle-set-edges region rl rt rr rb))
 		   ;; Move the record
-		   (output-record-set-position* output-record (- x delta-x) (- y delta-y))
+		   (output-record-set-position output-record (- x delta-x) (- y delta-y))
 		   ;; Replay the region it used to live in, and then replay
 		   ;; the record in its new home.
 		   (when repaint
diff --git a/clim/excl-presentations.lisp b/clim/excl-presentations.lisp
index a4087cdb..faa9407b 100644
--- a/clim/excl-presentations.lisp
+++ b/clim/excl-presentations.lisp
@@ -21,7 +21,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: excl-presentations.lisp,v 1.7 92/03/06 14:17:45 cer Exp Locker: cer $
+;; $fiHeader: excl-presentations.lisp,v 1.8 92/03/09 17:41:46 cer Exp $
 
 
 (in-package :clim-internals)
@@ -33,7 +33,7 @@
   nil)
 
 (defclass standard-excl-presentation (standard-presentation) 
-	  ()
+    ()
   (:default-initargs :single-box nil))
 
 (defmethod initialize-instance :around ((rec standard-excl-presentation)
@@ -41,14 +41,14 @@
 					&key (type nil type-p)
 					     object)
   (when (and 
-	 ;; (null type-p)
-	 ;;--- If its a lisp kind of object then we want to generate expressions
-	 ;;--- but in the lisp thats all we generate to there
-	 ;;--- should be a problem
-	 t)
+	  ;; (null type-p)
+	  ;;--- If its a lisp kind of object then we want to generate expressions
+	  ;;--- but in the lisp thats all we generate to there
+	  ;;--- should be a problem
+	  t)
     (setf (getf args :type) 
-      #-ignore 'expression
-      #+ignore (presentation-type-of object)))
+	  #-ignore 'expression
+	  #+ignore (presentation-type-of object)))
   (apply #'call-next-method rec args))
 
 (defmethod excl::stream-presentation-record-type ((stream output-recording-mixin))
@@ -60,19 +60,18 @@
 
 (defmethod excl::set-io-record-pos1 ((stream output-recording-mixin) record)
   (let ((current-output-position 
-	 (stream-output-history-position stream)))
+	  (stream-output-history-position stream)))
     (multiple-value-bind (px py)
-	(point-position* current-output-position)
+	(point-position current-output-position)
       (declare (type coordinate px py))
       (multiple-value-bind (cursor-x cursor-y)
-	  (stream-cursor-position* stream)
+	  (stream-cursor-position stream)
 	(declare (type coordinate cursor-x cursor-y))
 	(multiple-value-bind (x y)
-	    (position-difference* cursor-x cursor-y px py)
-	  (output-record-set-start-cursor-position* record x y)
+	    (position-difference cursor-x cursor-y px py)
+	  (output-record-set-start-cursor-position record x y)
 	  (stream-close-text-output-record stream)
-	  (push (list (stream-current-output-record stream)
-		      px py)
+	  (push (list (stream-current-output-record stream) px py)
 		*gross-output-history-stack*)
 	  (setf (point-x current-output-position) cursor-x
 		(point-y current-output-position) cursor-y
@@ -81,22 +80,19 @@
 (defmethod excl::set-io-record-pos2 ((stream output-recording-mixin) record)
   (stream-close-text-output-record stream)
   (let ((current-output-position 
-	 (stream-output-history-position stream))) 
-    (destructuring-bind
-	(parent abs-x abs-y) (pop *gross-output-history-stack*)
-      
+	  (stream-output-history-position stream))) 
+    (destructuring-bind (parent abs-x abs-y)
+	(pop *gross-output-history-stack*)
       (unless parent 
 	(setq parent (stream-output-history stream)))
-
       (multiple-value-bind (end-x end-y)
-	  (stream-cursor-position* stream)
+	  (stream-cursor-position stream)
 	(declare (type coordinate end-x end-y))
-	(output-record-set-end-cursor-position*
-	 record (- end-x abs-x) (- end-y abs-y)))
+	(output-record-set-end-cursor-position
+	  record (- end-x abs-x) (- end-y abs-y)))
       (setf (point-x current-output-position) abs-x
 	    (point-y current-output-position) abs-y
 	    (stream-current-output-record stream) parent)
-      #+ignore(print (list parent abs-x abs-y) excl:*initial-terminal-io*)
       (when parent
 	(add-output-record record parent)))))
 
@@ -106,14 +102,14 @@
 ;;; Somehow this does not integrate with the CLIM mechanism
 (defmethod excl::stream-set-font ((stm output-protocol) font-spec)
   (setf (medium-text-style stm)
-    (etypecase font-spec
-      ((nil)
-       (pop *font-stack-hack*)))
-    (character
-     (push (medium-text-style stm) *font-stack-hack*)
-     (ecase (char-downcase font-spec)
-       (#\r (window-stream-regular-font     stm))
-       (#\b (window-stream-bold-font        stm))
-       (#\i (window-stream-italic-font      stm))
-       (#\j (window-stream-bold-italic-font stm))))))
+	(etypecase font-spec
+	  ((nil)
+	   (pop *font-stack-hack*))
+	  (character
+	    (push (medium-text-style stm) *font-stack-hack*)
+	    (ecase (char-downcase font-spec)
+	      (#\r (window-stream-regular-font     stm))
+	      (#\b (window-stream-bold-font        stm))
+	      (#\i (window-stream-italic-font      stm))
+	      (#\j (window-stream-bold-italic-font stm)))))))
      
diff --git a/clim/frames.lisp b/clim/frames.lisp
index 718117b7..c2643c77 100644
--- a/clim/frames.lisp
+++ b/clim/frames.lisp
@@ -1,6 +1,7 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; ;; $fiHeader: frames.lisp,v 1.12 92/04/03 12:04:34 cer Exp Locker: cer $
+;; $fiHeader: frames.lisp,v 1.11 92/03/24 19:37:49 cer Exp $
+
 
 (in-package :clim-internals)
 
@@ -13,7 +14,6 @@
 ;;--- We should add an input event-queue to frames, so that other
 ;;--- processes can queue up requests.  This queue should be managed
 ;;--- like other event queues.  It can contains "command" events, too.
-
 (defclass standard-application-frame (application-frame)
     ;;--- Is it right for these to be SHEET accessors??
     ((name :initarg :name :accessor frame-name)
@@ -41,15 +41,13 @@
 		     :reader frame-current-layout)
      (default-size :initform nil :initarg :default-size)
      (shell :accessor frame-shell)
-     (pointer-documentationp
-      :initarg :pointer-documentation
-      :reader frame-pointer-documentationp)
+     (pointer-documentation-p :initarg :pointer-documentation
+			      :reader frame-pointer-documentation-p)
      (pointer-documentation-pane :initform nil)
      (properties :initform nil :initarg :properties
 		 :accessor frame-properties))
-  (:default-initargs 
-      :pointer-documentation nil
-      :top-level 'default-frame-top-level))
+  (:default-initargs :pointer-documentation nil
+		     :top-level 'default-frame-top-level))
 
 (defmethod port ((frame standard-application-frame))
   (port (frame-manager frame)))
@@ -57,29 +55,24 @@
 (defmethod graft ((frame standard-application-frame))
   (graft (frame-manager frame)))
 
-
-(defmethod frame-pointer-documentation-output ((frame standard-application-frame))
-  (with-slots (pointer-documentation-pane) frame
-    pointer-documentation-pane))
-
 #+CLIM-1-compatibility
 (define-compatibility-function (frame-top-level-window frame-top-level-sheet)
 			       (frame)
   (frame-top-level-sheet frame))
 
 (defmethod initialize-instance :after ((frame standard-application-frame) 
-				       &rest args &key 
-						  frame-manager
-						  (parent frame-manager))
+				       &rest args
+				       &key frame-manager
+					    (parent frame-manager))
   (declare (ignore args))
   (let ((frame-manager
-	 (etypecase parent
-	   (null (find-frame-manager))
-	   (list (apply #'find-frame-manager parent))
-	   (frame-manager parent)
-	   (application-frame (frame-manager parent))
-	   (port (find-frame-manager :port parent))
-	   (sheet (frame-manager (pane-frame parent))))))
+	  (etypecase parent
+	    (null (find-frame-manager))
+	    (list (apply #'find-frame-manager parent))
+	    (frame-manager parent)
+	    (application-frame (frame-manager parent))
+	    (port (find-frame-manager :port parent))
+	    (sheet (frame-manager (pane-frame parent))))))
     (setf (slot-value frame 'frame-manager) frame-manager)
     (adopt-frame frame-manager frame)))
 
@@ -103,8 +96,7 @@
 (defmacro define-application-frame (name superclasses slots &rest options)
   #+Genera (declare (zwei:indentation 1 25 2 3 3 1))
   (with-warnings-for-definition name define-application-frame
-    (let (pane panes layout top-level menu-bar
-	  pointer-documentation
+    (let (pane panes layout top-level menu-bar pointer-documentation
 	  command-definer command-table disabled-commands)
       (macrolet ((extract (name keyword default &optional (pair t))
 		   `(let ((entry (assoc ',keyword options)))
@@ -119,14 +111,13 @@
 				   `((assert (listp (rest entry)) (entry)
 					     "The remainder of ~S must be a list" entry)
 				     (setq ,name (rest entry)
-					   options (delete entry
-							   options)))))))))
-	(extract pointer-documentation :pointer-documentation nil)
+					   options (delete entry options)))))))))
 	(extract pane :pane nil)
 	(extract panes :panes nil nil)
 	(extract layout :layout nil nil)
 	(extract top-level :top-level '(default-frame-top-level))
 	(extract menu-bar :menu-bar t)
+	(extract pointer-documentation :pointer-documentation nil)
 	(extract command-definer :command-definer t)
 	(extract command-table :command-table t)
 	(extract disabled-commands :disabled-commands nil))
@@ -175,8 +166,8 @@
 	   (defclass ,name ,superclasses ,slots
 	     ,@options
 	     (:default-initargs
-		 :pointer-documentation ',pointer-documentation
-		 :menu-bar ',menu-bar
+	       :menu-bar ',menu-bar
+	       :pointer-documentation ',pointer-documentation
 	       ,@(and command-table `(:command-table ',(car command-table)))
 	       ,@(and top-level `(:top-level ',top-level))
 	       ,@(and panes `(:pane-constructors ,pane-constructors))
@@ -378,16 +369,13 @@
 	  (setq width  (space-requirement-width sr)
 		height (space-requirement-height sr))))
       ;;--- Don't bother with this if the size didn't change?
-      ;;-- This is wrong We want to resize the top level sheet
-      ;;; (allocate-space panes width height)
       (resize-sheet* 
-       (or (frame-top-level-sheet frame)
-	   panes)
-       width height
-       ;;-- we need to do this because if the wm has changed the sheet
-       ;; then this will not change its size but we need it to start
-       ;; the layout stuff
-       :force t))))
+	(or (frame-top-level-sheet frame) panes)
+	width height
+	;; We need to do this because if the WM has changed the sheet
+	;; then this will not change its size but we need it to start
+	;; the layout stuff
+	:force t))))
 
 (defmethod (setf frame-current-layout) (nv (frame standard-application-frame))
   (unless (eq (frame-current-layout frame) nv)
@@ -549,34 +537,33 @@
   (loop
     (catch 'layout-changed
       (let* ((*standard-output*
-	      (or (frame-standard-output frame) *standard-output*))
+	       (or (frame-standard-output frame) *standard-output*))
 	     (*standard-input* 
-	      (or (frame-standard-input frame) *standard-output*))
+	       (or (frame-standard-input frame) *standard-output*))
 	     (*query-io* 
-	      (or (frame-query-io frame) *standard-input*))
+	       (or (frame-query-io frame) *standard-input*))
 	     (*error-output* 
-	      (or (frame-error-output frame) *standard-output*))
+	       (or (frame-error-output frame) *standard-output*))
 	     (interactor
-	      (not (null (find-frame-pane-of-type frame 'interactor-pane))))
+	       (not (null (find-frame-pane-of-type frame 'interactor-pane))))
 	     (*command-parser*
-	      (or command-parser
-		  (if interactor
-		      #'command-line-command-parser
-		    #'menu-command-parser)))
+	       (or command-parser
+		   (if interactor
+		       #'command-line-command-parser
+		       #'menu-command-parser)))
 	     (*command-unparser*
-	      (or command-unparser 
-		  #'command-line-command-unparser))
+	       (or command-unparser 
+		   #'command-line-command-unparser))
 	     (*partial-command-parser* 
-	      (or partial-command-parser
-		  (if interactor
-		      #'command-line-read-remaining-arguments-for-partial-command
-		    #'menu-read-remaining-arguments-for-partial-command)))
+	       (or partial-command-parser
+		   (if interactor
+		       #'command-line-read-remaining-arguments-for-partial-command
+		       #'menu-read-remaining-arguments-for-partial-command)))
 	     (command-stream
-	      (typecase *standard-input*
-		(output-protocol-mixin
-		 *standard-input*)
-		(t
-		 (frame-top-level-sheet frame)))))
+	       ;;--- I'm not really convinced that this is right
+	       (typecase *standard-input*
+		 (output-protocol-mixin *standard-input*)
+		 (t (frame-top-level-sheet frame)))))
 	#+Allegro
 	(unless (typep *standard-input* 'excl::bidirectional-terminal-stream)
 	  (assert (port *standard-input*)))
@@ -663,23 +650,23 @@
   (cond ((pane-display-function pane)
 	 (let* ((ir (slot-value pane 'incremental-redisplay-p))
 		(redisplay-p (if (listp ir) (first ir) ir))
-		(check-overlapping (or (atom ir) ;default is T
+		(check-overlapping (or (atom ir)	;default is T
 				       (getf (rest ir) :check-overlapping t))))
 	   (with-simple-restart (nil "Skip redisplaying pane ~S" pane)
 	     (loop
 	       (with-simple-restart (nil "Retry displaying pane ~S" pane)
 		 (return
 		   (let ((redisplay-record
-			  (and redisplay-p
-			       (let ((history (stream-output-history pane)))
-				 (when history
-				   #+compulsive-redisplay
-				   (when (> (output-record-count history) 1)
-				     (cerror "Clear the output history and proceed"
-					     "There is more than one element in this redisplay pane")
-				     (window-clear pane))
-				   (unless (zerop (output-record-count history))
-				     (output-record-element history 0)))))))
+			   (and redisplay-p
+				(let ((history (stream-output-history pane)))
+				  (when history
+				    #+compulsive-redisplay
+				    (when (> (output-record-count history) 1)
+				      (cerror "Clear the output history and proceed"
+					      "There is more than one element in this redisplay pane")
+				      (window-clear pane))
+				    (unless (zerop (output-record-count history))
+				      (output-record-element history 0)))))))
 		     (cond ((and redisplay-p
 				 (or force-p (null redisplay-record)))
 			    (when force-p
@@ -689,8 +676,7 @@
 			    (redisplay redisplay-record pane 
 				       :check-overlapping check-overlapping))
 			   (t
-			    (invoke-pane-display-function frame
-							  pane))))))))))
+			    (invoke-pane-display-function frame pane))))))))))
 	(force-p
 	 ;;-- Is there anything else we need to do?
 	 (stream-replay pane))))
@@ -791,7 +777,7 @@
     #+Allegro
     (when (and *click-outside-menu-handler*
 		(output-recording-stream-p window)
-		(not (region-contains-point*-p (stream-output-history window) x y)))
+		(not (region-contains-position-p (stream-output-history window) x y)))
       (funcall *click-outside-menu-handler*))
     (when highlighted-presentation
       ;; Unhighlight on the way out.
@@ -827,14 +813,17 @@
 (defmethod frame-error-output ((frame standard-application-frame))
   (frame-standard-output frame))
 
+(defmethod frame-pointer-documentation-output ((frame standard-application-frame))
+  (with-slots (pointer-documentation-pane) frame
+    pointer-documentation-pane))
+
 ;;--- This causes direct-manipulation and menu-driven applications not to
 ;;--- maintain histories.  Is there a better heuristic?
 (defmethod frame-maintain-presentation-histories ((frame standard-application-frame))
   (not (null (find-frame-pane-of-type frame 'interactor-pane))))
 
-;;--- What should this really do?
-
 (defmethod notify-user (frame format-string &rest format-arguments) 
+  (declare (dynamic-extent format-arguments))
   (apply #'port-notify-user (port frame) frame format-string format-arguments))
 
 
@@ -891,7 +880,7 @@
 (defun frame-document-highlighted-presentation-1
        (frame presentation input-context window x y stream)
   (let ((modifier-state (window-modifier-state window)))
-    (declare (fixnum modifier-state))
+    (declare (type fixnum modifier-state))
     (multiple-value-bind (left   left-presentation   left-context
 			  middle middle-presentation middle-context
 			  right  right-presentation  right-context)
@@ -908,7 +897,7 @@
 		 ;; Assumes 5 modifier keys and the reverse ordering of *MODIFIER-KEYS*
 		 (let ((bit #o20)
 		       (shift-name '("h-" "s-" "m-" "c-" "sh-")))
-		   (declare (fixnum bit))
+		   (declare (type fixnum bit))
 		   (dotimes (i 5)
 		     #-(or Allegro Minima) (declare (ignore i))
 		     (unless (zerop (logand bit modifier-state))
@@ -922,6 +911,8 @@
 						   :documentation-type :pointer)
 		 (write-string separator stream)))
 	  (declare (dynamic-extent #'document-translator))
+	  ;;--- The button names should be hard-wired in.  Consider 1-button
+	  ;;--- Macs and 2-button PCs...
 	  (when left
 	    (let ((button-name (cond ((and (eq left middle)
 					   (eq left right))
diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp
index 9534dce5..f8818839 100644
--- a/clim/gadget-output.lisp
+++ b/clim/gadget-output.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: gadget-output.lisp,v 1.8 92/03/24 19:37:52 cer Exp Locker: cer $
+;; $fiHeader: gadget-output.lisp,v 1.9 92/04/10 14:27:02 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -41,7 +41,7 @@
   (setf (output-record-gadget rec) gadget)
   (let ((sr (compose-space gadget)))
     (multiple-value-bind (abs-x abs-y)
-	(point-position*
+	(point-position
 	 (stream-output-history-position stream))
       (decf x abs-x)
       (decf y abs-y)
@@ -62,7 +62,7 @@
   (declare (ignore  a b c d))
   (update-gadget-position rec))
 
-(defmethod bounding-rectangle-set-position* :after ((rec gadget-output-record) a b)
+(defmethod bounding-rectangle-set-position :after ((rec gadget-output-record) a b)
   (declare (ignore  a b))
   (update-gadget-position rec))
 
@@ -75,7 +75,7 @@
 	  (do ((parent record (output-record-parent parent)))
 	      ((null parent))
 	    (multiple-value-bind (x y)
-		(output-record-position* parent)
+		(output-record-position parent)
 	      (incf xoff x)
 	      (incf yoff y)))
 	  (move-and-resize-sheet* gadget
@@ -126,13 +126,13 @@
     (assert frame)
     (assert framem)
     (multiple-value-bind (x y)
-	(stream-cursor-position* stream)
+	(stream-cursor-position stream)
       (let* (gadget
 	     (record
 	      (with-new-output-record (stream 'gadget-output-record record)
-		;;--- Do we really need to do this. under what
-		;;--- situations does this happen and why cant we loose
-		;;--- the gadget
+		;;--- Do we really need to do this?  Under what
+		;;--- situations does this happen and why can't we
+		;;--- release the gadget?
 		(unless (setq gadget (output-record-gadget record))
 		  (associate-record-and-gadget
 		   record
@@ -148,7 +148,7 @@
     (assert frame)
     (assert framem)
     (multiple-value-bind (x y)
-	(stream-cursor-position* stream)
+	(stream-cursor-position stream)
       (let* (gadget
 	     (record
 	      (with-new-output-record (stream 'gadget-output-record record)
@@ -227,22 +227,21 @@
   ;; value-key, test, sequence
   (with-output-as-gadget (stream)
     (let* ((gadget
-	    (make-pane 'radio-box 
-			  :label (and (stringp prompt) prompt)
-			  :value-changed-callback
+	     (make-pane 'radio-box 
+			:label (and (stringp prompt) prompt)
+			:client stream :id query-identifier
+			:value-changed-callback
 			  (make-accept-values-value-changed-callback
-			   stream query-identifier)
-			  :client stream
-			  :id query-identifier)))
+			    stream query-identifier))))
       (dolist (element sequence)
 	(make-pane 'toggle-button 
-		      :value (and default-supplied-p
-				  (funcall test 
-					   (funcall value-key element)
-					   (funcall value-key default)))
-		      :label (princ-to-string element)
-		      :id element
-		      :parent gadget))
+		   :label (princ-to-string element)
+		   :value (and default-supplied-p
+			       (funcall test 
+					(funcall value-key element)
+					(funcall value-key default)))
+		   :id element
+		   :parent gadget))
       gadget)))
 
 
@@ -258,20 +257,19 @@
 						    present-p query-identifier
 						    &key (prompt t))
   (declare (ignore default-supplied-p present-p))
-  (let ((x (with-output-as-gadget (stream)
-	     (make-pane 'toggle-button
-			   :client stream 
-			   :value-changed-callback
-			   (make-accept-values-value-changed-callback
-			    stream query-identifier)
-			   :id query-identifier
-			   :value default
-			   :label (and (stringp prompt) prompt)))))
-    ;;--- WE end up not making a new gadget sometimes, I think because
+  (let ((gadget
+	  (with-output-as-gadget (stream)
+	    (make-pane 'toggle-button
+		       :label (and (stringp prompt) prompt)
+		       :value default
+		       :client stream :id query-identifier
+		       :value-changed-callback
+		         (make-accept-values-value-changed-callback
+			   stream query-identifier)))))
+    ;;--- We end up not making a new gadget sometimes, I think because
     ;;--- we find a gadget already in the record so we need to modify
-    ;;-- the value!
-    (setf (gadget-value x) default)))
-    
+    ;;--- the value!
+    (setf (gadget-value gadget) default)))
 
 ;;; Integer gadget
 
@@ -287,14 +285,13 @@
   (declare (ignore present-p))
   (with-output-as-gadget (stream)
     (make-pane 'slider
-		  :value-changed-callback
-		  (make-accept-values-value-changed-callback
-		   stream query-identifier)
-		  :client stream
-		  :width 100
-		  :value (if default-supplied-p default 0)
-		  :id query-identifier
-		  :label (and (stringp prompt) prompt))))
+	       :label (and (stringp prompt) prompt)
+	       :value (if default-supplied-p default 0)
+	       :client stream :id query-identifier
+	       :value-changed-callback
+	         (make-accept-values-value-changed-callback
+		   stream query-identifier))))
+
 
 
 ;;--- These should be defined in the standard DEFOPERATION way...
diff --git a/clim/gestures.lisp b/clim/gestures.lisp
index 055672b7..e3f4bd0d 100644
--- a/clim/gestures.lisp
+++ b/clim/gestures.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gestures.lisp,v 1.4 92/03/04 16:21:43 cer Exp $
+;; $fiHeader: gestures.lisp,v 1.5 92/03/10 10:12:36 cer Exp $
 
 (in-package :clim-internals)
 
@@ -69,7 +69,7 @@
 
 ;; BUTTON is a button number (0, 1, or 2), and MODIFIER-STATE is a mask
 (defun-inline button-and-modifier-state-gesture-names (button modifier-state)
-  (declare (fixnum button modifier-state))
+  (declare (type fixnum button modifier-state))
   (aref *button-and-modifier-key->gesture* button modifier-state))
 
 ;; BUTTON is a button number (0, 1, or 2), and MODIFIER-STATE is a mask
@@ -138,7 +138,7 @@
 
 ;; We typically have our hands on a button index and a modifier key state,
 ;; and we need to know if it matches a named gesture
-;; BUTTON is a button number (0, 1, or 2), and STATE is a mask.
+
 (defun-inline button-and-modifier-state-matches-gesture-name-p (button state gesture-name)
   (or (eq gesture-name 't)
       (member gesture-name (button-and-modifier-state-gesture-names button state))))
@@ -159,12 +159,12 @@
 (defun button-press-event-matches-gesture-name-p (event gesture-name)
   (let ((button (pointer-event-button event))
 	(modifier-state (event-modifier-state event)))
-    (declare (fixnum button modifier-state))
+    (declare (type fixnum button modifier-state))
     (button-and-modifier-state-matches-gesture-name-p
       (- (integer-length button) #.(integer-length +pointer-left-button+))
       modifier-state gesture-name)))
 
-;;--- Shouldn't #\A match (:A :SHIFT), and so forth?
+;; GESTURE-NAME either names a gesture, or is a canonicalized gesture spec
 (defun keyboard-event-matches-gesture-name-p (event gesture-name)
   (when (and (characterp event)
 	     (characterp gesture-name)
@@ -173,40 +173,66 @@
   (multiple-value-bind (keysym modifier-state character)
       (etypecase event
 	(character
+	  ;;--- This should canonicalize #\a into :A, and #\A into :A (:SHIFT),
+	  ;;--- and so forth
 	  (values nil 0 event))
 	(key-press-event
 	  (values (keyboard-event-key-name event)
 		  (event-modifier-state event)
 		  (keyboard-event-character event))))
-    (declare (fixnum modifier-state))
-    (let ((bucket (aref *keysym-and-modifier-key->gesture* modifier-state)))
-      ;;--- Presently allows both keysyms and characters.  Is that right?
-      (or (member gesture-name (cdr (assoc keysym bucket)))
-	  (member gesture-name (cdr (assoc character bucket)))))))
+    (declare (type fixnum modifier-state))
+    (cond ((consp gesture-name)
+	   (and (eql keysym (first gesture-name))
+		(eq modifier-state (apply #'make-modifier-state (rest gesture-name)))))
+	  (t
+	   (let ((bucket (aref *keysym-and-modifier-key->gesture* modifier-state)))
+	     (or (member gesture-name (cdr (assoc keysym bucket)))
+		 (member gesture-name (cdr (assoc character bucket)))))))))
 
 (defun-inline keyboard-event-p (x)
   (or (characterp x)
       (typep x 'key-press-event)))
 
+;;--- This accepts way too much...
 (defun keyboard-gesture-spec-p (x)
-  (let ((keysym (if (consp x) (first x) x))
-	(modifiers (and (consp x) (rest x))))
-    (and (or (characterp keysym)
-	     (symbolp keysym))
-	 (every #'(lambda (x) (find x *modifier-keys*)) modifiers))))
-
-;;--- Shouldn't #\A match (:A :SHIFT), and so forth?
-(defun gesture-eql (gesture1 gesture2)
-  (let ((g1-keysym (if (consp gesture1) (first gesture1) gesture1))
-	(g1-modifiers (and (consp gesture1) (rest gesture1)))
-	(g2-keysym (if (consp gesture2) (first gesture2) gesture2))
-	(g2-modifiers (and (consp gesture2) (rest gesture2))))
-    (and (or (eql g1-keysym g2-keysym)
-	     (and (characterp g1-keysym)
-		  (characterp g2-keysym)
-		  (char-equal g1-keysym g2-keysym)))
-	 (every #'(lambda (x) (member x g2-modifiers)) g1-modifiers)
-	 (every #'(lambda (x) (member x g1-modifiers)) g2-modifiers))))
+  (multiple-value-bind (keysym modifiers) (decode-gesture-spec x)
+    (declare (ignore modifiers))
+    keysym))
+
+(defun gesture-spec-eql (gesture1 gesture2)
+  (multiple-value-bind (k1 m1) (decode-gesture-spec gesture1)
+    (multiple-value-bind (k2 m2) (decode-gesture-spec gesture2)
+      (and (or (eql k1 k2)
+	       (and (characterp k1)
+		    (characterp k2)
+		    (char-equal k1 k2)))
+	   (equal m1 m2)))))
+
+(defun decode-gesture-spec (gesture-spec &key (errorp t))
+  (declare (values button modifiers))
+  (when (atom gesture-spec)
+    (return-from decode-gesture-spec
+      (values gesture-spec nil)))
+  (let ((modifiers nil)
+	(button nil))
+    (dolist (x gesture-spec)
+      (cond ((find x *modifier-keys*)
+	     (if (member x modifiers)
+		 (if errorp
+		     (cerror "Ignore the extra modifier"
+			     "The modifier ~S appears more than once in the gesture spec ~S"
+			     x gesture-spec)
+		     (return-from decode-gesture-spec nil))
+		 (push x modifiers)))
+	    (button
+	     (if errorp
+		 (error "The gesture spec ~S is invalid" gesture-spec)
+		 (return-from decode-gesture-spec nil)))
+	    (t
+	     (setq button x))))
+    ;;--- This should canonicalize #\a into :A, and #\A into :A (:SHIFT),
+    ;;--- and so forth.
+    (values button (nreverse modifiers))))
 
 
 (defun add-gesture-name (name type gesture-spec &key (unique t))
@@ -215,10 +241,9 @@
     (delete-gesture-name name))
   (ecase type
     (:keyboard
-      (destructuring-bind (key-name &rest modifiers) gesture-spec
+      (multiple-value-bind (key-name modifiers)
+	  (decode-gesture-spec gesture-spec)
 	(check-type key-name (or symbol character))
-	(assert (every #'(lambda (x) (find x *modifier-keys*)) modifiers) (modifiers)
-		"~S is not a subset of ~S" modifiers '(:shift :control :meta :super :hyper))
 	(let* ((index (apply #'make-modifier-state modifiers))
 	       (bucket (aref *keysym-and-modifier-key->gesture* index))
 	       (entry (assoc key-name bucket)))
@@ -230,10 +255,9 @@
 		 (push entry (aref *keysym-and-modifier-key->gesture* index))))
 	  bucket)))
     (:pointer-button
-      (destructuring-bind (button &rest modifiers) gesture-spec
+      (multiple-value-bind (button modifiers)
+	  (decode-gesture-spec gesture-spec)
 	(check-type button (member :left :middle :right))
-	(assert (every #'(lambda (x) (find x *modifier-keys*)) modifiers) (modifiers)
-		"~S is not a subset of ~S" modifiers '(:shift :control :meta :super :hyper))
 	(pushnew name (button-and-modifier-state-gesture-names
 			(button-index button)
 			(apply #'make-modifier-state modifiers)))))))
diff --git a/clim/graph-formatting.lisp b/clim/graph-formatting.lisp
index f6faae54..e90297a0 100644
--- a/clim/graph-formatting.lisp
+++ b/clim/graph-formatting.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graph-formatting.lisp,v 1.6 92/02/24 13:07:40 cer Exp $
+;; $fiHeader: graph-formatting.lisp,v 1.7 92/03/04 16:21:44 cer Exp $
 
 (in-package :clim-internals)
 
@@ -75,13 +75,13 @@
   (bounding-rectangle-left node))
 
 (defmethod (setf graph-node-x) (new-value (node standard-graph-node-output-record))
-  (output-record-set-position* node new-value (bounding-rectangle-top node)))
+  (output-record-set-position node new-value (bounding-rectangle-top node)))
 
 (defmethod graph-node-y ((node standard-graph-node-output-record))
   (bounding-rectangle-top node))
 
 (defmethod (setf graph-node-y) (new-value (node standard-graph-node-output-record))
-  (output-record-set-position* node (bounding-rectangle-left node) new-value))
+  (output-record-set-position node (bounding-rectangle-left node) new-value))
 
 
 ;; For compatibility...
@@ -216,7 +216,7 @@
 		  (node-breadth (node-breadth ,node-var))
 		  (breadth-margin ,within-generation-separation-var)
 		  (depth-margin ,generation-separation-var)
-		  (tallest-child 0))
+		  (tallest-child (coordinate 0)))
 	      (declare (type coordinate start-breadth node-breadth
 			     		depth-margin breadth-margin tallest-child))
 	      (dolist (child children)
@@ -298,7 +298,7 @@
 				 (parent-attachment-position parent)
 			       (multiple-value-bind (child-x child-y)
 				   (child-attachment-position child)
-				 (translate-fixnum-positions xoff yoff
+				 (translate-coordinates xoff yoff
 				   parent-x parent-y child-x child-y)
 				 ;;--- This really needs to pass the objects, too
 				 (apply arc-drawer stream
@@ -386,21 +386,21 @@
   (with-slots (orientation center-nodes
 	       generation-separation within-generation-separation n-generations
 	       root-nodes hash-table) graph
-    (let ((start-x 0)
-	  (start-y 0))
+    (let ((start-x (coordinate 0))
+	  (start-y (coordinate 0)))
       (flet ((inferior-mapper (function node)
 	       (map nil function (graph-node-children node)))
-	     (yx-output-record-set-position* (record y x)
-	       (output-record-set-position* record x y)))
-	(declare (dynamic-extent #'inferior-mapper #'yx-output-record-set-position*))
+	     (yx-output-record-set-position (record y x)
+	       (output-record-set-position record x y)))
+	(declare (dynamic-extent #'inferior-mapper #'yx-output-record-set-position))
 	(multiple-value-bind (breadthfun depthfun set-positionfun start-breadth start-depth)
 	    (ecase orientation
 	      ((:vertical :down :up)
 	       (values #'bounding-rectangle-width #'bounding-rectangle-height
-		       #'output-record-set-position* start-x start-y))
+		       #'output-record-set-position start-x start-y))
 	      ((:horizontal :right :left)
 	       (values #'bounding-rectangle-height #'bounding-rectangle-width
-		       #'yx-output-record-set-position* start-y start-x)))
+		       #'yx-output-record-set-position start-y start-x)))
 	  (macrolet ((traverse (new-node-function &optional (old-node-function '#'false))
 		       `(traverse-graph root-nodes #'inferior-mapper 
 					hash-table #'identity
@@ -414,7 +414,7 @@
 			  collect (make-generation-descriptor
 				    :generation generation
 				    :breadth-so-far start-breadth)))
-		  (max-gen-breadth 0) 
+		  (max-gen-breadth (coordinate 0)) 
 		  broadest-gen-descr)
 	      (when (member orientation '(:up :left))
 		(setq generation-descriptors (nreverse generation-descriptors)))
@@ -460,7 +460,8 @@
 				  (generation-breadth-so-far descr)
 				  (if center-nodes
 				      (+ (generation-start-depth descr)
-					 (floor (- (generation-depth descr) (depth child-node)) 2))
+					 (floor (- (generation-depth descr)
+						   (depth child-node)) 2))
 				      (generation-start-depth descr)))
 			 (incf (generation-breadth-so-far descr) (breadth child-node)))))
 		(declare (dynamic-extent #'place-node))
@@ -508,7 +509,7 @@
 				 (funcall parent-attach parent)
 			       (multiple-value-bind (child-x child-y)
 				   (funcall child-attach child)
-				 (translate-fixnum-positions xoff yoff
+				 (translate-coordinates xoff yoff
 				   parent-x parent-y child-x child-y)
 				 ;;--- This really needs to pass the objects, too
 				 (apply arc-drawer stream 
diff --git a/clim/graphics-recording.lisp b/clim/graphics-recording.lisp
index 28498006..bf7cb812 100644
--- a/clim/graphics-recording.lisp
+++ b/clim/graphics-recording.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graphics-recording.lisp,v 1.2 92/03/30 17:52:26 cer Exp Locker: cer $
+;; $fiHeader: graphics-recording.lisp,v 1.3 92/04/14 15:29:53 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -58,12 +58,12 @@
 			    (member 'line-style medium-components))
 		   `((when filled (setq line-style nil))))
 	       (multiple-value-bind (abs-x abs-y)
-		   (point-position* (stream-output-history-position medium))
+		   (point-position (stream-output-history-position medium))
 		 (declare (type coordinate abs-x abs-y))
 		 ,@(mapcar #'(lambda (p)
-			       `(transform-point-sequence (transformation) ,p))
+			       `(transform-position-sequence (transformation) ,p))
 			   point-sequences-to-transform)
-		 (transform-points (transformation) ,@points-to-transform)
+		 (transform-positions (transformation) ,@points-to-transform)
 		 (transform-distances (transformation) ,@distances-to-transform)
 		 (let ((record
 			 (make-instance ',class
@@ -76,10 +76,10 @@
 		     (bounding-rectangle-set-edges
 		       record
 		       (- lf abs-x) (- tp abs-y) (- rt abs-x) (- bt abs-y))
-		     (multiple-value-bind (cx cy) (stream-cursor-position* medium)
+		     (multiple-value-bind (cx cy) (stream-cursor-position medium)
 		       (declare (type coordinate cx cy))
 		       ;; Doing this directly beats calling
-		       ;; OUTPUT-RECORD-SET-START-CURSOR-POSITION*
+		       ;; OUTPUT-RECORD-SET-START-CURSOR-POSITION
 		       (with-slots (start-x start-y) record
 			 (setq start-x (- cx abs-x)
 			       start-y (- cy abs-y))))
@@ -107,30 +107,30 @@
 	   (with-slots (,@slots) record
 	     (with-sheet-medium (medium stream)
 	       (letf-globally (((medium-transformation medium) +identity-transformation+))
-	        (with-drawing-options 
-		   (medium ,@(mapcan #'(lambda (medium-component)
-					 (list (intern (symbol-name medium-component)
-						       *keyword-package*)
-					       medium-component))
-				     medium-components))
-		  (let (,@(when (and (member 'filled function-args)
-				    (member 'line-style medium-components))
-			   `((filled (not line-style))))
-		       ,@(mapcar #'(lambda (p) (list p p))
-				 points-to-transform)
-		       ,@(mapcar #'(lambda (p) (list p p))
-				 point-sequences-to-transform))
-		   ,@(mapcar #'(lambda (p)
-				 `(setq ,p (adjust-point-sequence 
-					     ,p (- x-offset) (- y-offset))))
-			     point-sequences-to-transform)
-		   (setf ,@(do ((p points-to-transform (cddr p))
-				r)
-			       ((null p) (nreverse r))
-			     (push (first p) r)
-			     (push `(+ ,(first p) x-offset) r)
-			     (push (second p) r)
-			     (push `(+ ,(second p) y-offset) r)))
+	         (with-drawing-options 
+		     (medium ,@(mapcan #'(lambda (medium-component)
+					   (list (intern (symbol-name medium-component)
+							 *keyword-package*)
+						 medium-component))
+				       medium-components))
+		   (let (,@(when (and (member 'filled function-args)
+				      (member 'line-style medium-components))
+			     `((filled (not line-style))))
+			 ,@(mapcar #'(lambda (p) (list p p))
+				   points-to-transform)
+			 ,@(mapcar #'(lambda (p) (list p p))
+				   point-sequences-to-transform))
+		     ,@(mapcar #'(lambda (p)
+				   `(setq ,p (adjust-point-sequence 
+					       ,p (- x-offset) (- y-offset))))
+			       point-sequences-to-transform)
+		     (setf ,@(do ((p points-to-transform (cddr p))
+				  r)
+				 ((null p) (nreverse r))
+			       (push (first p) r)
+			       (push `(+ ,(first p) x-offset) r)
+			       (push (second p) r)
+			       (push `(+ ,(second p) y-offset) r)))
 		     (,medium-graphics-function* medium ,@function-args)))))))
 	 
 	 ,@(when highlighting-test
@@ -165,7 +165,7 @@
 	   ((record output-record-mixin) x-offset y-offset)
   (let ((designs nil))
     (flet ((make-design (record)
-	     (multiple-value-bind (xoff yoff) (output-record-position* record)
+	     (multiple-value-bind (xoff yoff) (output-record-position record)
 	       (declare (type coordinate xoff yoff))
 	       (let ((design
 		       (make-design-from-output-record-1
@@ -241,7 +241,7 @@
 (defmethod draw-design ((point standard-point) stream &rest args &key ink line-style)
   (declare (dynamic-extent args)
 	   (ignore ink line-style))
-  (multiple-value-bind (x y) (point-position* point)
+  (multiple-value-bind (x y) (point-position point)
     (apply #'draw-point* stream x y args)))
 
 
@@ -328,8 +328,6 @@
      (with-slots (x1 y1 x2 y2 line-style) record
        (or (null line-style)
 	   (with-half-thickness (lthickness rthickness) line-style
-	     ;; Don't use LTRB-CONTAINS-POINT*-P, since that expects fixnums
-	     ;;---- Not any more!
 	     (not (and (<= (+ x1 rthickness) x)
 		       (<= (+ y1 rthickness) y)
 		       (>= (- x2 lthickness) x)
@@ -380,7 +378,7 @@
 	   ((polygon polygon-output-record) x-offset y-offset)
   (with-slots (list-of-xs-and-ys closed line-style ink) polygon
     (let ((coords (copy-list list-of-xs-and-ys)))
-      (translate-point-sequence x-offset y-offset coords)
+      (translate-position-sequence x-offset y-offset coords)
       (compose-in
 	ink
 	(if (null line-style)
@@ -421,6 +419,15 @@
       ((null p))
     (funcall fn (car p) (cadr p))))
 
+(defun adjust-point-sequence (list-of-x-and-ys dx dy)
+  (let (r)
+    (map-point-sequence
+     #'(lambda (x y)
+	 (push (- x dx) r)
+	 (push (- y dy) r))
+     list-of-x-and-ys)
+    (nreverse r)))
+
 
 (define-output-recorder ellipse-output-record draw-ellipse (ink line-style)
   :bounding-rectangle
@@ -553,16 +560,3 @@
 		     vb (+ y (round height 2)))))
     (values vx vt vr vb)))
 
-
-;;--- Does anyone use this?
-(defun adjust-point-sequence (list-of-x-and-ys dx dy)
-  (let (r)
-    (map-point-sequence
-     #'(lambda (x y)
-	 (push (- x dx) r)
-	 (push (- y dy) r))
-     list-of-x-and-ys)
-    (nreverse r)))
-
-
-       
diff --git a/clim/histories.lisp b/clim/histories.lisp
index f376ed9e..cd8a3843 100644
--- a/clim/histories.lisp
+++ b/clim/histories.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: histories.lisp,v 1.3 92/02/24 13:07:47 cer Exp $
+;; $fiHeader: histories.lisp,v 1.4 92/03/04 16:21:47 cer Exp $
 
 (in-package :clim-internals)
 
@@ -446,6 +446,16 @@
 (defmethod canonicalize-default ((history presentation-history) element)
   (unparse-presentation-history-element history element))
 
+#+compulsive-type-checking
+(defmethod push-history-element :around ((history presentation-history) element)
+  (when (and (presentation-typep
+	       (presentation-history-element-object element)
+	       (presentation-history-element-type element))
+	     (presentation-subtypep
+	       (presentation-history-element-type element)
+	       (presentation-history-type history)))
+    (call-next-method)))
+
 (defmethod history-replace-input
 	   ((history presentation-history) (istream input-editing-stream-mixin) element
 	    &key replace-previous)
diff --git a/clim/incremental-redisplay.lisp b/clim/incremental-redisplay.lisp
index 6a2beb08..352e050e 100644
--- a/clim/incremental-redisplay.lisp
+++ b/clim/incremental-redisplay.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: incremental-redisplay.lisp,v 1.3 92/02/24 13:07:49 cer Exp $
+;; $fiHeader: incremental-redisplay.lisp,v 1.4 92/03/04 16:21:50 cer Exp $
 
 (in-package :clim-internals)
 
@@ -43,7 +43,8 @@
       ;; UPDATING-OUTPUT-RECORD's can be easily moved through the
       ;; hierarchy, in which case it would be slightly expensive to
       ;; convert from relative to absolute coordinates.
-      (old-position :initform (make-point 0 0) :initarg :old-position
+      (old-position :initform (make-point (coordinate 0) (coordinate 0)) 
+		    :initarg :old-position
 		    :accessor output-record-old-cursor-position)
       (old-parent :initform nil :initarg :old-parent
 		  :accessor output-record-old-parent)))
@@ -51,7 +52,9 @@
 (define-output-record-constructor standard-updating-output-record
 				  (&key x-position y-position (size 25)
 					unique-id cache-value fixed-position
-					displayer all-new (old-position (make-point 0 0))
+					displayer all-new
+					(old-position 
+					  (make-point (coordinate 0) (coordinate 0)))
 					old-parent)
   :x-position x-position :y-position y-position :size size
   :unique-id unique-id :cache-value cache-value :fixed-position fixed-position
@@ -72,7 +75,7 @@
     (if (null old-bounding-rectangle)
 	(setf old-bounding-rectangle (bounding-rectangle record))	;cons a new rectangle
 	(bounding-rectangle record old-bounding-rectangle))
-    (output-record-set-old-start-cursor-position* record start-x start-y)
+    (output-record-set-old-start-cursor-position record start-x start-y)
     (setf contents-ok (not (null old-is-ok)))
     (unless old-is-ok
       (setf parent nil))))
@@ -129,6 +132,7 @@
 ;; some of the arguments, and then passes it on to the real (and generic)
 ;; FIND-INFERIOR-OUTPUT-RECORD.  FIND-INFERIOR-OUTPUT-RECORD is the exported
 ;; interface, and is defined in the protocol.
+;;--- Rename to FIND-CHILD-OUTPUT-RECORD-1
 (defun find-inferior-output-record-1 (record record-type &rest init-args)
   (declare (dynamic-extent init-args))
    (apply #'find-inferior-output-record
@@ -138,6 +142,7 @@
 	  record-type
 	  init-args))
 
+;;--- Rename to DECACHE-CHILD-OUTPUT-RECORD-1
 (defun decache-inferior-output-record-1 (record child)
   (decache-inferior-output-record
     record child
@@ -172,6 +177,7 @@
 	(find item sequence :key key :test #'robust-test)
         (find item sequence :key key))))
 
+;;--- Rename to FIND-CHILD-OUTPUT-RECORD
 (defmethod find-inferior-output-record
 	   ((record output-record-mixin) use-old-children record-type
 	    &rest init-args &key unique-id id-test &allow-other-keys)
@@ -223,6 +229,7 @@
 		    #'no-unique-id) 
 		record)))))))
 
+;;--- Rename to DECACHE-CHILD-OUTPUT-RECORD-1
 (defmethod decache-inferior-output-record
 	   ((record output-record-mixin) child use-old-children)
   (when use-old-children
@@ -269,12 +276,12 @@
 				    (and (zerop width) (zerop height)))
 				  (multiple-value-bind (our-delta-x our-delta-y)
 				      (multiple-value-bind (sx sy)
-					  (output-record-start-cursor-position* child)
+					  (output-record-start-cursor-position child)
 					(declare (type coordinate sx sy))
 					(multiple-value-bind (osx osy)
-					    (output-record-old-start-cursor-position* child)
+					    (output-record-old-start-cursor-position child)
 					  (declare (type coordinate osx osy))
-					  (position-difference* sx sy osx osy)))
+					  (position-difference sx sy osx osy)))
 				    (declare (type coordinate our-delta-x our-delta-y))
 				    (if (null delta-x)
 					(setf delta-x our-delta-x delta-y our-delta-y)
@@ -294,7 +301,7 @@
 		      (if old-bounding-rectangle
 			  (bounding-rectangle-position-difference
 			    record old-bounding-rectangle)
-			  (values 0 0))
+			  (values (coordinate 0) (coordinate 0)))
 		    (and (= delta-x e-delta-x) (= delta-y e-delta-y))))
 	  (setf (output-record-contents-ok record) t)
 	  ;; If delta-x wasn't set, then we didn't see any relevant
@@ -306,9 +313,9 @@
 	    ;; COMPUTE-DIFFERENCES will never walk down past this record,
 	    ;; since contents-ok is T.
 	    (multiple-value-bind (new-x new-y)
-		(output-record-start-cursor-position* record)
+		(output-record-start-cursor-position record)
 	      (declare (type coordinate new-x new-y))
-	      (output-record-set-old-start-cursor-position*
+	      (output-record-set-old-start-cursor-position
 		record (- new-x delta-x) (- new-y delta-y)))))))))
 
 
@@ -336,11 +343,11 @@
     (multiple-value-bind (x y)
 	(if y
 	    (values (+ x (- parent-x sup-x)) (+ y (- parent-y sup-y)))
-	    (output-record-position* record))
+	    (output-record-position record))
       (declare (type coordinate x y))
       (with-end-of-page-action (stream :allow)
 	(with-stream-cursor-position-saved (stream)
-	  (stream-set-cursor-position*
+	  (stream-set-cursor-position
 	    stream (+ sup-x x) (+ sup-y y))
 	  (with-stream-redisplaying (stream)
 	    (let ((parent (output-record-parent record)))
@@ -366,7 +373,9 @@
 	  (output-record-parent record) record :change
 	  ;; You can use the state saved by COPY-DISPLAY-STATE here, since
 	  ;; the contract of NEW-OUTPUT-RECORDS is to maintain the old state.
-	  (output-record-old-start-cursor-position record)
+	  (multiple-value-bind (x y)
+	      (output-record-old-start-cursor-position record)
+	    (make-point x y))
 	  (output-record-old-bounding-rectangle record)
 	  stream
 	  erases moves draws erase-overlapping move-overlapping))))
@@ -388,6 +397,7 @@
 ;; Mode is one of :DELETE, :ADD, :CHANGE, :MOVE, or :NONE
 ;; If you don't recursively call your parent, then it is >your<
 ;; responsibility to call INCREMENTAL-REDISPLAY.
+;;--- Rename to NOTE-OUTPUT-RECORD-CHILD-CHANGED
 (defmethod inferior-output-record-changed ((parent output-record-mixin) child mode
 					   old-child-position old-child-extent	;of child
 					   stream
@@ -402,7 +412,10 @@
 						 old-child-position old-child-extent)
      (with-slots (old-bounding-rectangle start-x start-y old-start-x old-start-y) parent
        (let ((old-parent-extent old-bounding-rectangle)
-	     (old-parent-position (output-record-old-start-cursor-position parent)))
+	     (old-parent-position
+	       (multiple-value-bind (x y)
+		   (output-record-old-start-cursor-position record)
+		 (make-point x y))))
 	 (setf old-start-x start-x old-start-y start-y)
 	 (if (null old-bounding-rectangle)
 	     (setf old-bounding-rectangle (bounding-rectangle parent))
@@ -420,7 +433,10 @@
 	       new-erases new-moves new-draws
 	       new-erase-overlapping new-move-overlapping))))))
     (t
-     (incremental-redisplay stream (output-record-start-cursor-position parent)
+     (incremental-redisplay stream 
+			    (multiple-value-bind (x y)
+				(output-record-start-cursor-position parent)
+			      (make-point x y))
 			    erases moves draws erase-overlapping move-overlapping))))
 
 ;; for efficiency we might want to pass in the five elements as an
@@ -432,6 +448,7 @@
 ;; from that origin to the parent of RECORD.
 ;;
 ;; Need to clip this to the visible viewport, but we'll do that later, too.
+;;--- Rename to COMPUTE-DIFFERENCE-SET
 (defmethod compute-differences ((record output-record-element-mixin)
 				&optional (check-overlapping nil)
 					  (x-offset 0) (y-offset 0)
@@ -455,10 +472,10 @@
 	     ;;--- but do we want to penalize the user?
 	     (when old-bounding-rectangle
 	       (multiple-value-bind (e-x e-y)
-		   (bounding-rectangle-position* record)
+		   (bounding-rectangle-position record)
 		 (declare (type coordinate e-x e-y))
 		 (multiple-value-bind (old-e-x old-e-y)
-		     (bounding-rectangle-position* old-bounding-rectangle)
+		     (bounding-rectangle-position old-bounding-rectangle)
 		   (declare (type coordinate old-e-x old-e-y))
 		   (unless (and (= (+ x-offset e-x) (+ old-x-offset old-e-x))
 				(= (+ y-offset e-y) (+ old-y-offset old-e-y)))
@@ -486,10 +503,10 @@
 	       (when (output-record-p record)
 		 ;; We have to look at the children.
 		 (multiple-value-bind (start-x start-y)
-		     (output-record-start-cursor-position* record)
+		     (output-record-start-cursor-position record)
 		   (declare (type coordinate start-x start-y))
 		   (multiple-value-bind (o-start-x o-start-y)
-		       (output-record-old-start-cursor-position* record)
+		       (output-record-old-start-cursor-position record)
 		     (declare (type coordinate o-start-x o-start-y))
 		     (dolist (child (output-record-old-children record))
 		       (erase child (bounding-rectangle-shift-position
@@ -539,10 +556,10 @@
 		     draws))
 	     (when (output-record-p record)
 	       (multiple-value-bind (start-x start-y)
-		   (output-record-start-cursor-position* record)
+		   (output-record-start-cursor-position record)
 		 (declare (type coordinate start-x start-y))
 		 (multiple-value-bind (o-start-x o-start-y)
-		     (output-record-old-start-cursor-position* record)
+		     (output-record-old-start-cursor-position record)
 		   (declare (type coordinate o-start-x o-start-y))
 		   (let ((x-offset (+ x-offset start-x))
 			 (y-offset (+ y-offset start-y))
@@ -562,7 +579,7 @@
 				  erase-overlapping move-overlapping)
   (with-output-recording-options (stream :draw t :record nil)
     (multiple-value-bind (xoff yoff)
-	(bounding-rectangle-position* position)
+	(bounding-rectangle-position position)
       (declare (type coordinate xoff yoff))
       ;; Do the erases first, then the moves, then the draws.
       ;; Do the draws in the "right" order.
@@ -580,12 +597,13 @@
       ;; All of this must be done relative to position...
       (flet ((erase-rectangle (stream rectangle)
 	       (with-bounding-rectangle* (left top right bottom) rectangle
-		 (translate-fixnum-positions xoff yoff left top right bottom)
-		 (draw-rectangle* stream left top right bottom :ink +background-ink+ :filled t)))
+		 (translate-coordinates xoff yoff left top right bottom)
+		 (draw-rectangle* stream left top right bottom
+				  :ink +background-ink+ :filled t)))
 	     (replay-record (record stream region)
 	       ;; REGION is the bounding rectangle
-	       (multiple-value-bind (x y) (bounding-rectangle-position* record)
-		 (multiple-value-bind (eleft etop) (bounding-rectangle-position* region)
+	       (multiple-value-bind (x y) (bounding-rectangle-position record)
+		 (multiple-value-bind (eleft etop) (bounding-rectangle-position region)
 		   (replay-output-record record stream nil
 					 (+ xoff (- eleft x)) (+ yoff (- etop y)))))))
 	(dolist (erase erases)
@@ -616,22 +634,22 @@
 (defmethod new-output-records ((record output-record-element-mixin) stream)
   ;; Position and bounding rectangle are identical on these guys.
   (multiple-value-bind (cursor-x cursor-y)
-      (stream-cursor-position* stream)
+      (stream-cursor-position stream)
     (declare (type coordinate cursor-x cursor-y))
     (multiple-value-bind (new-x new-y)
 	(multiple-value-bind (px py)
-	    (point-position*
+	    (point-position
 	      (stream-output-history-position stream))
 	  (declare (type coordinate px py))
-	  (position-difference* cursor-x cursor-y px py))
+	  (position-difference cursor-x cursor-y px py))
       (declare (type coordinate new-x new-y))
       ;; because we don't know what to do, just do the same thing as before...
       (copy-display-state record t)
-      (output-record-set-start-cursor-position* record new-x new-y))
+      (output-record-set-start-cursor-position record new-x new-y))
     (multiple-value-bind (delta-x delta-y)
-	(output-record-end-cursor-position* record)
+	(output-record-end-cursor-position record)
       (declare (type coordinate delta-x delta-y))
-      (stream-set-cursor-position*
+      (stream-set-cursor-position
 	stream (+ cursor-x delta-x) (+ cursor-y delta-y)))))
 
 ;; If you do REDISPLAY on a random output-record, do you want it to walk
@@ -658,10 +676,13 @@
 ;; old-inferior-extent and inferior-extent, are all relative to the
 ;; parents start-position.  Nothing is relative to the parent's
 ;; old-start-position.
+;;--- Rename to PROPAGATE-OUTPUT-RECORD-CHANGES-P
 (defmethod propagate-inferior-output-record-changes-p
 	   ((record output-record-mixin) child mode
 	    &optional (old-child-position 
-			(output-record-old-start-cursor-position child))
+			(multiple-value-bind (x y)
+			    (output-record-old-start-cursor-position child)
+			  (make-point x y)))
 		      (old-child-extent
 			(output-record-old-bounding-rectangle child)))
   #---ignore
@@ -670,14 +691,16 @@
   (and (if (or (eq mode :change) (eq mode :move) (eq mode :none))
 	   (or (not (bounding-rectangle-position-equal
 		      old-child-position 
-		      (output-record-start-cursor-position child)))
+		      (multiple-value-bind (x y)
+		          (output-record-start-cursor-position child)
+			(make-point x y))))
 	       (not (bounding-rectangle-edges-equal
 		      old-child-extent (bounding-rectangle child))))
 	   ;; mode is :add or :delete.
 	   (multiple-value-bind (width height) (bounding-rectangle-size child)
 	     (declare (type coordinate width height))
 	     (not (and (zerop width) (zerop height)))))
-       (multiple-value-bind (x-offset y-offset) (output-record-position* record)
+       (multiple-value-bind (x-offset y-offset) (output-record-position record)
 	 (declare (type coordinate x-offset y-offset))
 	 (with-bounding-rectangle* (left top right bottom) record
 	   (block anything-needs-moving
@@ -713,8 +736,12 @@
 ;; --- still needs to be implemented...
 (defmethod propagate-output-record-changes
 	   ((record output-record-mixin) child mode
-	    &optional (old-child-position (output-record-old-start-cursor-position child))
-		      (old-child-extent (output-record-old-bounding-rectangle child))
+	    &optional (old-child-position 
+			(multiple-value-bind (x y)
+			    (output-record-old-start-cursor-position child)
+			  (make-point x y)))
+		      (old-child-extent
+			(output-record-old-bounding-rectangle child))
 		      erases moves draws erase-overlapping move-overlapping)
   (declare (values new-mode new-erases new-moves new-draws
 		   new-erase-overlapping new-move-overlapping))
@@ -737,6 +764,7 @@
 
 ;; just use default, for now.
 #+ignore
+;;--- Rename to FIND-CHILD-OUTPUT-RECORD
 (defmethod find-inferior-output-record ((record standard-updating-output-record)
 					use-old-children record-type
 					&rest init-args &key unique-id id-test
@@ -755,7 +783,7 @@
 (defmethod reposition-output-record ((output-record standard-updating-output-record)
 				     stream x y abs-x abs-y)
   (multiple-value-bind (delta-x delta-y)
-      (output-record-end-cursor-position* output-record)
+      (output-record-end-cursor-position output-record)
     (declare (type coordinate delta-x delta-y))
     (copy-display-state output-record t)
     (cond ((output-record-fixed-position output-record)
@@ -767,16 +795,16 @@
 	   ;; well-thought-out design.  It just seemed like the right
 	   ;; thing after three minutes of thought.
 	   (multiple-value-bind (abs-x abs-y)
-	       (point-position*
+	       (point-position
 		 (stream-output-history-position stream))
 	     (declare (type coordinate abs-x abs-y))
-	     (multiple-value-bind (x y) (output-record-position* output-record)
+	     (multiple-value-bind (x y) (output-record-position output-record)
 	       (declare (type coordinate x y))
-	       (stream-set-cursor-position*
+	       (stream-set-cursor-position
 		 stream (+ abs-x x delta-x) (+ abs-y y delta-y)))))
 	  (t
-	   (output-record-set-start-cursor-position* output-record x y)
-	   (stream-set-cursor-position*
+	   (output-record-set-start-cursor-position output-record x y)
+	   (stream-set-cursor-position
 	     stream (+ abs-x delta-x) (+ abs-y delta-y))))))
 
 ;; The contents of the output-record are not yet known to be ok, so we're going to have to run
@@ -789,7 +817,7 @@
   (letf-globally (((stream-current-redisplay-record stream) output-record))
     ;; OK, now copy and reinitialize
     (copy-display-state output-record nil)
-    (output-record-set-start-cursor-position* output-record x y)
+    (output-record-set-start-cursor-position output-record x y)
     (with-output-record-1 continuation
 			  stream output-record abs-x abs-y)))
 
@@ -903,13 +931,13 @@
     (if output-record
 	;; we've already been through this path once, just update if necessary.
 	(multiple-value-bind (cursor-x cursor-y)
-	    (stream-cursor-position* stream)
+	    (stream-cursor-position stream)
 	  (declare (type coordinate cursor-x cursor-y))
 	  (multiple-value-bind (x y)
 	      (multiple-value-bind (px py)
-		  (point-position* current-output-record-position)
+		  (point-position current-output-record-position)
 		(declare (type coordinate px py))
-		(position-difference* cursor-x cursor-y px py))
+		(position-difference cursor-x cursor-y px py))
 	    (declare (type coordinate x y))
 	    ;; Update displayer, in case something changed.  
 	    (flet ((updating-output-displayer (stream)
@@ -932,10 +960,10 @@
 	      ;; old extent is bogus, since it is relative to
 	      ;; old-parent. Convert it to be relative to current-output-record.
 	      (multiple-value-call 
-		#'output-record-set-start-cursor-position*
+		#'output-record-set-start-cursor-position
 		output-record
 		;; could be wildly out of bounding box, but that's OK.
-		(bounding-rectangle-position-difference	;this works on points, too
+		(bounding-rectangle-position-difference
 		  ;; old-position is cached absolute coordinates
 		  (output-record-old-cursor-position output-record)
 		  current-output-record-position)))
@@ -982,7 +1010,7 @@
 		   (when redisplay-piece
 		     (cache-output-record redisplay-piece record unique-id id-test))
 		   (multiple-value-bind (x y)
-		       (stream-cursor-position* stream)
+		       (stream-cursor-position stream)
 		     (letf-globally (((stream-current-redisplay-record stream) record))
 		       (funcall continuation stream))
 		     (let ((position (output-record-old-cursor-position record)))
diff --git a/clim/input-defs.lisp b/clim/input-defs.lisp
index a05a1c9e..984d5e63 100644
--- a/clim/input-defs.lisp
+++ b/clim/input-defs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: input-defs.lisp,v 1.5 92/02/24 13:07:51 cer Exp $
+;; $fiHeader: input-defs.lisp,v 1.6 92/03/04 16:21:52 cer Exp $
 
 (in-package :clim-internals)
 
@@ -16,8 +16,11 @@
     ((root :accessor pointer-root :initform nil :initarg :root)
      (window :accessor pointer-window :initform nil)
      ;; Position in root coordinates 
+     ;;--- Are these of type COORDINATE or FIXNUM?
      (x-position :accessor pointer-x-position :initform 0)
      (y-position :accessor pointer-y-position :initform 0)
+     ;;--- Are these of type COORDINATE or FIXNUM?
+     ;;--- It's clear that they need to be FIXed before passing them to the host
      (native-x-position :accessor pointer-native-x-position :initform 0)
      (native-y-position :accessor pointer-native-y-position :initform 0)
      (button-state :accessor pointer-button-state :initform 0)
@@ -35,31 +38,35 @@
 (progn
   (declaim (notinline pointer-window (setf pointer-window))))
 
-(defmethod pointer-position* ((pointer standard-pointer))
+(defmethod pointer-position ((pointer standard-pointer))
   (with-slots (x-position y-position) pointer
     (values x-position y-position)))
 
-;; NEW-X and NEW-Y had better be fixnums
-;;--- Coerce X and Y to COORDINATE
-(defmethod pointer-set-position* ((pointer standard-pointer) new-x new-y)
-  (declare (type coordinate new-x new-y))
+(defmethod pointer-set-position ((pointer standard-pointer) new-x new-y)
   (with-slots (x-position y-position position-changed) pointer
-    (setf x-position new-x
-	  y-position new-y
+    (setf x-position (coordinate new-x)
+	  y-position (coordinate new-y)
 	  position-changed t))
   (values new-x new-y))
 
-(defmethod pointer-native-position* ((pointer standard-pointer))
+#+CLIM-1-compatibility
+(define-compatibility-function (pointer-position* pointer-position)
+			       (pointer)
+  (pointer-position pointer))
+
+#+CLIM-1-compatibility
+(define-compatibility-function (pointer-set-position* pointer-set-position)
+			       (pointer x y)
+  (pointer-set-position pointer x y))
+
+(defmethod pointer-native-position ((pointer standard-pointer))
   (with-slots (native-x-position native-y-position) pointer
     (values native-x-position native-y-position)))
 
-;; NEW-X and NEW-Y had better be fixnums
-;;--- Coerce X and Y to COORDINATE
-(defmethod pointer-set-native-position* ((pointer standard-pointer) new-x new-y)
-  (declare (type coordinate new-x new-y))
+(defmethod pointer-set-native-position ((pointer standard-pointer) new-x new-y)
   (with-slots (native-x-position native-y-position position-changed) pointer
-    (setf native-x-position new-x
-	  native-y-position new-y
+    (setf native-x-position (coordinate new-x)
+	  native-y-position (coordinate new-y)
 	  position-changed t))
   (values new-x new-y))
 
@@ -80,8 +87,8 @@
       (let ((native-x-position (pointer-native-x-position pointer))
 	    (native-y-position (pointer-native-y-position pointer)))
 	(multiple-value-setq (native-x-position native-y-position)
-	  (untransform-point* (sheet-native-transformation window) 
-			      native-x-position native-y-position))
+	  (untransform-position (sheet-native-transformation window) 
+				native-x-position native-y-position))
 	(setf (pointer-x-position pointer) native-x-position
 	      (pointer-y-position pointer) native-y-position)))))
 
diff --git a/clim/input-editor-commands.lisp b/clim/input-editor-commands.lisp
index 1c867970..4144ff2b 100644
--- a/clim/input-editor-commands.lisp
+++ b/clim/input-editor-commands.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: input-editor-commands.lisp,v 1.5 92/03/10 10:12:37 cer Exp Locker: cer $
+;; $fiHeader: input-editor-commands.lisp,v 1.6 92/03/10 15:40:10 cer Exp $
 
 (in-package :clim-internals)
 
@@ -250,7 +250,7 @@
 		       (stream-output-history window))))
     (when (and window
 	       (pane-viewport window))
-      (multiple-value-bind (x y) (window-viewport-position* window)
+      (multiple-value-bind (x y) (window-viewport-position window)
 	(incf y (* (if (= distance 1)
 		       (bounding-rectangle-height (window-viewport window))
 		       (* distance (stream-line-height window)))
@@ -258,7 +258,7 @@
 	(with-bounding-rectangle* (hleft htop hright hbottom) history
 	  (declare (ignore hleft hright))
 	  (setq y (min (max htop y) hbottom)))
-	(window-set-viewport-position* window x y)))))
+	(window-set-viewport-position window x y)))))
 
 
 ;;; Some macrology for talking about the input-buffer
@@ -670,8 +670,8 @@
   (:ie-forward-word	    :\F  :meta)
   (:ie-backward-character   :\B  :control)
   (:ie-backward-word	    :\B  :meta)
-  (:ie-beginning-of-buffer  :\< :meta)
-  (:ie-end-of-buffer	    :\> :meta)
+  (:ie-beginning-of-buffer  :\<  :meta)
+  (:ie-end-of-buffer	    :\>  :meta)
   (:ie-beginning-of-line    :\A  :control)
   (:ie-end-of-line	    :\E  :control)
   (:ie-next-line	    :\N  :control)
diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp
index 7f213482..094fd504 100644
--- a/clim/input-protocol.lisp
+++ b/clim/input-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: input-protocol.lisp,v 1.9 92/03/10 10:12:39 cer Exp Locker: cer $
+;; $fiHeader: input-protocol.lisp,v 1.10 92/03/30 17:52:30 cer Exp $
 
 (in-package :clim-internals)
 
@@ -89,20 +89,20 @@
       (setf (cursor-stream text-cursor) stream)
       (setf (cursor-visibility text-cursor) initial-cursor-visibility))))
 
-;;; --- Cross-protocol violation here because the cursor-position* is a method on
-;;; --- extended-OUTPUT-protocol right now.  Secondly, this should probably be a method
-;;; --- on the abstract class, anyway.
+;;; --- Cross-protocol violation here because CURSOR-POSITION is a method on
+;;; --- extended-OUTPUT-protocol right now.  Secondly, this should probably be a
+;;; --- method on the abstract class, anyway.
 #+Silica
-(defmethod stream-set-cursor-position* :after ((stream input-protocol-mixin) x y)
+(defmethod stream-set-cursor-position :after ((stream input-protocol-mixin) x y)
   (let ((cursor (stream-text-cursor stream)))
     (when cursor
-      (cursor-set-position* cursor x y))))
+      (cursor-set-position cursor x y))))
 
 #+Silica
-(defmethod stream-set-cursor-position*-internal :after ((stream input-protocol-mixin) x y)
+(defmethod stream-set-cursor-position-internal :after ((stream input-protocol-mixin) x y)
   (let ((cursor (stream-text-cursor stream)))
     (when cursor
-      (cursor-set-position* cursor x y))))
+      (cursor-set-position cursor x y))))
 
 
 (defmethod initialize-menu :before (port (menu input-protocol-mixin) associated-window)
@@ -127,7 +127,7 @@
       (when (and (cursor-active cursor)
 		 (cursor-state cursor)
 		 (cursor-focus cursor))
-	(multiple-value-bind (x y) (cursor-position* cursor)
+	(multiple-value-bind (x y) (cursor-position cursor)
 	  (multiple-value-bind (width height)
 	      (cursor-width-and-height-pending-protocol cursor)
 	    (let ((cursor-rect (make-bounding-rectangle x y (+ x width) (+ y height))))
@@ -200,8 +200,8 @@
 
 (defmethod queue-event ((stream input-protocol-mixin) (event pointer-motion-event))
   (let ((pointer (stream-primary-pointer stream)))
-    (pointer-set-position* pointer (pointer-event-x event) (pointer-event-y event))
-    (pointer-set-native-position*
+    (pointer-set-position pointer (pointer-event-x event) (pointer-event-y event))
+    (pointer-set-native-position
       pointer 
       (pointer-event-native-x event) (pointer-event-native-y event))
     (setf (pointer-button-state pointer) 
@@ -243,15 +243,15 @@
     (set-pointer-window-and-location window pointer)))
 
 #-Silica
-(defmethod window-set-viewport-position* :around ((stream input-protocol-mixin) new-x new-y)
+(defmethod window-set-viewport-position :around ((stream input-protocol-mixin) new-x new-y)
   (declare (ignore new-x new-y))
   (let ((cursor (stream-text-cursor stream)))
     (if cursor
 	;; Shifting the viewport may need to redraw the cursor
 	(multiple-value-bind (x y)
-	    (cursor-position* cursor)
+	    (cursor-position cursor)
 	  (call-next-method)
-	  (cursor-set-position* cursor x y))
+	  (cursor-set-position cursor x y))
 	(call-next-method))))
 
 
@@ -461,11 +461,11 @@
 ;;; stream-read-gesture directly.
 (defun read-gesture (&rest args &key (stream *standard-input*) &allow-other-keys)
   (declare (arglist &key (stream *standard-input*)
-		    timeout peek-p input-wait-test input-wait-handler
-		    pointer-button-press-handler))
+			 timeout peek-p input-wait-test input-wait-handler
+			 pointer-button-press-handler))
   (declare (dynamic-extent args))
   (with-keywords-removed (keywords args '(:stream))
-		 (apply #'stream-read-gesture stream keywords)))
+    (apply #'stream-read-gesture stream keywords)))
 
 (defmethod stream-unread-gesture ((stream input-protocol-mixin) gesture)
   (queue-unget (stream-input-buffer stream) gesture))
@@ -687,20 +687,32 @@
   nil)
 
 
-;;; STREAM-POINTER-POSITION* method returns x,y in history coordinates.
+;;; STREAM-POINTER-POSITION method returns X,Y in history coordinates.
 ;;; Around methods take care of this (see protocol-intermediaries.lisp)
-(defmethod stream-pointer-position* ((stream input-protocol-mixin) &key (timeout 0) pointer)
+(defmethod stream-pointer-position ((stream input-protocol-mixin) &key (timeout 0) pointer)
   (stream-pointer-position-in-window-coordinates stream :timeout timeout :pointer pointer))
 
-(defmethod stream-set-pointer-position* ((stream input-protocol-mixin) x y &key pointer)
+(defmethod stream-set-pointer-position ((stream input-protocol-mixin) x y &key pointer)
   (set-stream-pointer-position-in-window-coordinates stream x y :pointer pointer))
 
+#+CLIM-1-compatibility
+(define-compatibility-function (stream-pointer-position* 
+				stream-pointer-position)
+			       (stream)
+  (stream-pointer-position stream))
+
+#+CLIM-1-compatibility
+(define-compatibility-function (stream-set-pointer-position*
+				stream-set-pointer-position)
+			       (stream x y)
+  (stream-set-pointer-position stream x y))
+
 ;;; The primitive we are interested in.  The pointer is in inside-host-window coords.
 #+Silica
 (defun stream-pointer-position-in-window-coordinates (stream &key (timeout 0) pointer)
   (declare (ignore timeout))
   (let ((pointer (or pointer (stream-primary-pointer stream))))
-    (pointer-position* pointer)))
+    (pointer-position pointer)))
 
 #-Silica
 (defun stream-pointer-position-in-window-coordinates (stream &key (timeout 0) pointer)
@@ -710,17 +722,17 @@
     (multiple-value-bind (left top) (window-offset stream)
       (declare (type coordinate left top))
       (if pointer
-	  (multiple-value-bind (x y) (pointer-position* pointer)
+	  (multiple-value-bind (x y) (pointer-position pointer)
 	    (declare (type coordinate x y))
 	    (values (- x left) (- y top)))
-	  (values 0 0)))))
+	  (values (coordinate 0) (coordinate 0))))))
 
 (defun set-stream-pointer-position-in-window-coordinates (stream x y &key pointer)
   (declare (type coordinate x y))
   (unless pointer (setf pointer (stream-primary-pointer stream)))
   (setf (pointer-position-changed pointer) t)
   #+Silica
-  (pointer-set-position* pointer x y)
+  (pointer-set-position pointer x y)
   #-Silica
   (multiple-value-bind (left top) (window-offset stream)
     (declare (type coordinate left top))
@@ -734,8 +746,9 @@
   (with-slots (input-buffer) stream
     (queue-put input-buffer
 	       ;; X and Y had better be fixnums
-	       ;;--- Coerce to COORDINATE
-	       (make-button-press-event stream x y button modifier-state))))
+	       (make-button-press-event stream 
+					(coordinate x) (coordinate y)
+					button modifier-state))))
 
 #-Silica
 (defmethod stream-note-pointer-button-release ((stream input-protocol-mixin)
@@ -743,9 +756,9 @@
   (declare (ignore pointer))
   (with-slots (input-buffer) stream
     (queue-put input-buffer
-	       ;; X and Y had better be fixnums
-	       ;;--- Coerce to COORDINATE
-	       (make-button-release-event stream x y button modifier-state))))
+	       (make-button-release-event stream
+					  (coordinate x) (coordinate y)
+					  button modifier-state))))
 
 #+Silica
 (defmethod stream-set-input-focus ((stream input-protocol-mixin))
diff --git a/clim/interactive-protocol.lisp b/clim/interactive-protocol.lisp
index ba8c58ca..3c1a788c 100644
--- a/clim/interactive-protocol.lisp
+++ b/clim/interactive-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: interactive-protocol.lisp,v 1.5 92/03/04 16:21:59 cer Exp $
+;; $fiHeader: interactive-protocol.lisp,v 1.6 92/03/10 10:12:42 cer Exp $
 
 (in-package :clim-internals)
 
@@ -151,11 +151,11 @@
       (unless end-position (setf end-position (fill-pointer input-buffer)))
       ;; cursor-X, cursor-Y are right if the start position is the insertion position.
       (cond ((= start-position 0)
-	     (multiple-value-setq (cursor-x cursor-y) (start-cursor-position* istream)))
+	     (multiple-value-setq (cursor-x cursor-y) (start-cursor-position istream)))
 	    ((= start-position insertion-pointer))
 	    (t
 	     (multiple-value-setq (cursor-x cursor-y)
-	       (input-buffer-input-position->cursor-position* istream start-position))))
+	       (input-buffer-input-position->cursor-position istream start-position))))
       ;; OK, now we know our cursor-(X,Y) and the line height.  Now scan things from here.
       (do-input-buffer-pieces (input-buffer :start start-position :end end-position)
 			      (from to noise-string)
@@ -229,8 +229,8 @@
 		     (accept-result-presentation-type next-char)))
 	    (t (apply #'accept-1 (or *original-stream* istream) type args))))))
 
-(defmethod input-buffer-input-position->cursor-position* ((istream input-editing-stream-mixin)
-							  &optional position)
+(defmethod input-buffer-input-position->cursor-position ((istream input-editing-stream-mixin)
+							 &optional position)
     (multiple-value-bind (cursor-x cursor-y)
 	(flet ((ignore (&rest args)
 		 (declare (ignore args))))
@@ -243,8 +243,8 @@
 				&optional (start-position 0))
   (with-slots (input-buffer stream insertion-pointer) istream
     (multiple-value-bind (x-pos y-pos)
-	(input-buffer-input-position->cursor-position* istream start-position)
-      (stream-set-cursor-position* stream x-pos y-pos))
+	(input-buffer-input-position->cursor-position istream start-position)
+      (stream-set-cursor-position stream x-pos y-pos))
     (macrolet ((do-part (from &optional to)
 		 `(do-input-buffer-pieces (input-buffer :start ,from :end ,to)
 					  (start-index end-index noise-string)
@@ -264,10 +264,10 @@
       (let ((ip (min insertion-pointer (fill-pointer input-buffer))))
 	(do-part start-position ip)
 	;; Remember where the cursor goes (at the insertion pointer!)
-	(multiple-value-bind (x-pos y-pos) (stream-cursor-position* istream)
+	(multiple-value-bind (x-pos y-pos) (stream-cursor-position istream)
 	  (do-part ip)
 	  ;; And put it there.
-	  (stream-set-cursor-position* stream x-pos y-pos))))
+	  (stream-set-cursor-position stream x-pos y-pos))))
     (force-output stream)))
 
 ;;--- Too bad this never gets called...
@@ -340,10 +340,10 @@
       (throw 'rescan (values)))))
 
 (defun shift-buffer-portion (buffer from-index to-index)
-  (declare (fixnum from-index to-index))
+  (declare (type fixnum from-index to-index))
   (let (#+(or Genera Minima) (buffer buffer)
 	(length (fill-pointer buffer)))
-    (declare (fixnum length))
+    (declare (type fixnum length))
     #+Genera (declare (sys:array-register buffer))
     #+Minima (declare (type vector buffer))
     (cond ((< from-index to-index)
@@ -411,7 +411,7 @@
   (with-slots (stream input-buffer scan-pointer insertion-pointer
 	       activation-gesture rescanning-p
 	       numeric-argument previous-history) istream
-    (declare (fixnum scan-pointer insertion-pointer))
+    (declare (type fixnum scan-pointer insertion-pointer))
     (loop	;until a real gesture is read or we throw out
       ;; First look in the input-buffer of the input-editor and see
       ;; if there's something there.
@@ -441,16 +441,16 @@
       ;;--- This is presumably much slower than necessary.
       ;;--- Perhaps there is a better way to keep track of where the cursor should be.
       (multiple-value-bind (x-pos y-pos)
-	  (input-buffer-input-position->cursor-position* istream insertion-pointer)
+	  (input-buffer-input-position->cursor-position istream insertion-pointer)
 	(declare (type coordinate x-pos y-pos))
 	(multiple-value-bind (cx cy)
-	    (stream-cursor-position* stream)
+	    (stream-cursor-position stream)
 	  (declare (type coordinate cx cy))
 	  ;; Don't set the cursor position if it's already right.
 	  ;; This prevents the input editor from scrolling the window after
 	  ;; the user has scrolled it back until the cursor position actually changes.
 	  (unless (and (= cx x-pos) (= cy y-pos))
-	    (stream-set-cursor-position* stream x-pos y-pos))))
+	    (stream-set-cursor-position stream x-pos y-pos))))
 
       (setf rescanning-p nil)
       (multiple-value-bind (thing type)
@@ -628,10 +628,10 @@
 (defmethod replace-input ((istream input-editing-stream-mixin) new-input
 			  &key (start 0) end rescan
 			       (buffer-start (input-position istream)))
-  (declare (fixnum start buffer-start))
+  (declare (type fixnum start buffer-start))
   (let ((rescan-p nil))
     (with-slots (input-buffer scan-pointer insertion-pointer) istream
-      (declare (fixnum scan-pointer insertion-pointer))
+      (declare (type fixnum scan-pointer insertion-pointer))
       (let* ((the-end (the fixnum (or end (length new-input))))
 	     (nchars (the fixnum (- the-end start)))
 	     (buffer-total-length (the fixnum (array-dimension input-buffer 0)))
@@ -737,7 +737,7 @@
       (original-stream-recording-p :accessor original-stream-recording-p)))
 
 ;;; Required methods:
-(defmethod start-cursor-position* ((istream standard-input-editing-stream))
+(defmethod start-cursor-position ((istream standard-input-editing-stream))
   (with-slots (start-x-position start-y-position) istream
     (values start-x-position start-y-position)))
 
@@ -747,13 +747,13 @@
 	;; in this specific implementation it's ok for
 	;; us to know that our encapsulated stream will
 	;; support the extended output protocol.
-	(stream-cursor-position* stream)
+	(stream-cursor-position stream)
       (setf start-x-position x
 	    start-y-position y))))
 
 (defmethod reset-cursor-position ((istream standard-input-editing-stream))
   (with-slots (stream start-x-position start-y-position) istream
-    (stream-set-cursor-position* stream start-x-position start-y-position)))
+    (stream-set-cursor-position stream start-x-position start-y-position)))
 
 (defmethod erase-input-buffer ((istream standard-input-editing-stream)
 			       &optional (start-position 0))
diff --git a/clim/menus.lisp b/clim/menus.lisp
index fa93046b..b294d6b3 100644
--- a/clim/menus.lisp
+++ b/clim/menus.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: menus.lisp,v 1.17 92/04/03 12:04:36 cer Exp Locker: cer $
+;; $fiHeader: menus.lisp,v 1.18 92/04/10 14:27:04 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -17,7 +17,8 @@
       (outlining ()
 	(scrolling ()
 	  (setq menu (make-pane 'clim-stream-pane
-				   :initial-cursor-visibility nil))))))
+				:initial-cursor-visibility nil))))))
+
   (:menu-bar nil))
 
 (defmethod frame-calling-frame ((frame menu-frame))
@@ -107,7 +108,7 @@
 		       parent-width)
 		  (min (+ (max label-height height) bottom-margin wtm wbm tm bm)
 		       parent-height)))))))
-      (window-set-viewport-position* menu left top)
+      (window-set-viewport-position menu left top)
       ;; blech
       (clear-input menu))))
 
@@ -121,7 +122,7 @@
 	     (width (min gw (+ (- maxx minx) right-margin)))
 	     (height (min gh (+ (- maxy miny) bottom-margin))))
 	(window-set-inside-size menu width height)
-	(window-set-viewport-position* menu minx miny)))))
+	(window-set-viewport-position menu minx miny)))))
 
 #-Silica
 (defun position-window-near-carefully (window x y)
@@ -137,8 +138,8 @@
 	  (setq left (- parent-width width)))
 	(when (> bottom parent-height)
 	  (setq top (- parent-height height)))
-	(bounding-rectangle-set-position* window
-					  (max 0 left) (max 0 top))))))
+	(bounding-rectangle-set-position window
+					 (max 0 left) (max 0 top))))))
 
 #-Silica
 (defun position-window-near-pointer (window &optional x y)
@@ -482,7 +483,7 @@
 	  #+Cloe-Runtime (stream-set-input-focus menu)
 	  (when default-presentation
 	    (with-bounding-rectangle* (left top right bottom) default-presentation
-	      (stream-set-pointer-position*
+	      (stream-set-pointer-position
 		menu (floor (+ left right) 2) (floor (+ top bottom) 2))))
 	  ;; Pointer documentation usually adds no information, and slows things
 	  ;; down in a big way, which is why we defaultly disable it.
diff --git a/clim/output-protocol.lisp b/clim/output-protocol.lisp
index 61fb0737..95fa1d40 100644
--- a/clim/output-protocol.lisp
+++ b/clim/output-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: output-protocol.lisp,v 1.8 92/03/04 16:22:03 cer Exp Locker: cer $
+;; $fiHeader: output-protocol.lisp,v 1.9 92/03/09 17:41:47 cer Exp $
 
 (in-package :clim-internals)
 
@@ -23,17 +23,18 @@
 
 (defclass output-protocol-mixin
 	  (basic-extended-output-protocol)
-     ((cursor-x :initform 0)
-      (cursor-y :initform 0)
-      (baseline :initform 0 :accessor stream-baseline)
+     ((cursor-x :initform (coordinate 0))
+      (cursor-y :initform (coordinate 0))
+      (baseline :initform (coordinate 0) :accessor stream-baseline)
       (foreground :initform +black+
 		  :accessor medium-foreground
 		  :initarg :stream-foreground)
       (background :initform +white+
 		  :accessor medium-background
 		  :initarg :stream-background)
-      (current-line-height :initform 0 :accessor stream-current-line-height)
-      (vertical-space :initform 2 :initarg :vertical-spacing 
+      (current-line-height :initform (coordinate 0)
+			   :accessor stream-current-line-height)
+      (vertical-space :initform (coordinate 2) :initarg :vertical-spacing 
 		      :accessor stream-vertical-spacing)
       (end-of-line-action :initarg :end-of-line-action
 			  :accessor stream-end-of-line-action)
@@ -135,7 +136,8 @@
 ;;--- I sure don't like having to do this to make string streams work
 (defmethod stream-default-view ((stream t)) +textual-view+)
 
-(defmethod stream-vertical-spacing ((stream t)) 0)
+(defmethod stream-vertical-spacing ((stream t)) 
+  (coordinate 0))
 
 ;;; The default text margin, by the way, isn't in user-visible coordinates.
 (defmethod stream-text-margin ((stream output-protocol-mixin))
@@ -214,42 +216,52 @@
 							  default-text-style))
 	       (setf merged-text-style-valid t)))))
 
-(defmethod stream-cursor-position* ((stream output-protocol-mixin))
+(defmethod stream-cursor-position ((stream output-protocol-mixin))
   (with-slots (cursor-x cursor-y) stream
     (values cursor-x cursor-y)))
 
-;; X and Y had better be fixnums
-;;--- Coerce to COORDINATE
-(defmethod stream-set-cursor-position* ((stream output-protocol-mixin) x y)
+(defmethod stream-set-cursor-position ((stream output-protocol-mixin) x y)
   (declare (type coordinate x y))
   (with-slots (cursor-x cursor-y current-line-height baseline) stream
-    (when x (setf cursor-x x))
+    (when x 
+      (setf cursor-x (coordinate x)))
     (when y
       (unless (eq y cursor-y)
-	(setf current-line-height 0 baseline 0))	;going to a new line
-      (setf cursor-y y)))
+	(setf current-line-height (coordinate 0)	;going to a new line
+	      baseline (coordinate 0)))
+      (setf cursor-y (coordinate y))))
   #+Silica
-  ;; --- Call explicitly in Silica version, rather than around methods on
-  ;; --- intermediary class.
+  ;;--- In the non-Silica case, this happens via an intermediary class
   (stream-ensure-cursor-visible stream x y))
 
-;; X and Y had better be fixnums
-;;--- Coerce to COORDINATE
-(defmethod stream-set-cursor-position*-internal ((stream output-protocol-mixin) x y)
+#+CLIM-1-compatibility
+(define-compatibility-function (stream-cursor-position*
+				stream-cursor-position)
+			       (stream)
+  (stream-cursor-position stream))
+
+#+CLIM-1-compatibility
+(define-compatibility-function (stream-set-cursor-position*
+				stream-set-cursor-position)
+			       (stream x y)
+  (stream-set-cursor-position stream x y))
+
+(defmethod stream-set-cursor-position-internal ((stream output-protocol-mixin) x y)
   (declare (type coordinate x y))
   (with-slots (cursor-x cursor-y current-line-height baseline) stream
-    (when x (setf cursor-x x))
+    (when x 
+      (setf cursor-x (coordinate x)))
     (when y
       (unless (eq y cursor-y)
-	(setf current-line-height 0 baseline 0))	;going to a new line
-      (setf cursor-y y)))
+	(setf current-line-height (coordinate 0)	;going to a new line
+	      baseline (coordinate 0)))
+      (setf cursor-y (coordinate y))))
   #+Silica
-  ;; --- Call explicitly in Silica version, rather than around methods on
-  ;; --- intermediary class.
+  ;;--- In the non-Silica case, this happens via an intermediary class
   (stream-ensure-cursor-visible stream x y))
 
 #+Genera
-(defmethod stream-compatible-cursor-position* ((stream output-protocol-mixin) &optional unit)
+(defmethod stream-compatible-cursor-position ((stream output-protocol-mixin) &optional unit)
   (with-slots (cursor-x cursor-y) stream
     (if (eq unit :character)
 	(values (floor cursor-x (stream-character-width stream #\m))
@@ -257,22 +269,22 @@
 	(values cursor-x cursor-y))))
 
 #+Genera
-(defmethod stream-compatible-set-cursor-position* ((stream output-protocol-mixin) x y
-						   &optional unit)
+(defmethod stream-compatible-set-cursor-position ((stream output-protocol-mixin) x y
+						  &optional unit)
   (when (eq unit :character)
     (setq x (* x (stream-character-width stream #\m))
 	  y (* y (stream-line-height stream))))
-  (stream-set-cursor-position* stream x y))
+  (stream-set-cursor-position stream x y))
 
 #+Genera
-(defmethod stream-compatible-increment-cursor-position* ((stream output-protocol-mixin) x y
-							 &optional unit)
+(defmethod stream-compatible-increment-cursor-position ((stream output-protocol-mixin) x y
+							&optional unit)
   (when (eq unit :character)
     (when x
       (setq x (* x (stream-character-width stream #\m))))
     (when y
       (setq y (* y (stream-line-height stream)))))
-  (stream-increment-cursor-position* stream x y))
+  (stream-increment-cursor-position stream x y))
 
 
 ;;; Make normal output streams obey some parts of other protocols for efficiency.
@@ -349,46 +361,52 @@
     (declare (ignore origin-x origin-y))
     (let ((new-x (floor (* column space-width))))
       (when (< (slot-value output-stream 'cursor-x) new-x)
-	(stream-set-cursor-position* output-stream new-x nil)
+	(stream-set-cursor-position output-stream new-x nil)
 	t))))
 
-(defmethod stream-increment-cursor-position* ((stream output-protocol-mixin) dx dy)
+(defmethod stream-increment-cursor-position ((stream output-protocol-mixin) dx dy)
   (declare (type coordinate dx dy))
   (with-slots (cursor-x cursor-y) stream
     (declare (type coordinate cursor-x cursor-y))
     (let ((cx (if dx (+ cursor-x dx) cursor-x))
 	  (cy (if dy (+ cursor-y dy) cursor-y)))
-      (stream-set-cursor-position* stream cx cy))))
+      (stream-set-cursor-position stream cx cy))))
+
+#+CLIM-1-compatibility
+(define-compatibility-function (stream-increment-cursor-position*
+				stream-increment-cursor-position)
+			       (stream dx dy)
+  (stream-increment-cursor-position stream dx dy))
 
 (defmethod stream-advance-cursor-x ((stream output-protocol-mixin) amount)
   (declare (type coordinate amount))
   (with-slots (cursor-x cursor-y) stream
     (declare (type coordinate cursor-x cursor-y))
-    (stream-set-cursor-position* 
+    (stream-set-cursor-position 
       stream (+ cursor-x amount) cursor-y)))
 
 (defmethod stream-advance-cursor-line ((stream output-protocol-mixin))
   (with-slots (cursor-x cursor-y vertical-space current-line-height baseline) stream
     (declare (type coordinate cursor-x cursor-y
 		              vertical-space current-line-height baseline))
-    (stream-set-cursor-position* 
+    (stream-set-cursor-position 
       stream 0 (+ cursor-y (stream-line-height stream) vertical-space))))
 
 (defmethod window-clear :before ((stream output-protocol-mixin))
   (with-slots (baseline current-line-height) stream
-    (setf baseline 0
-	  current-line-height 0)))
+    (setf baseline (coordinate 0)
+	  current-line-height (coordinate 0))))
 
 ;;; --- Should probably be on some intermediary class, since it can only
 ;;; be run when the stream is part of a WINDSHIELD hierarchy.
 #+Silica
-;; --- See comment on stream-set-cursor-position*
+;; --- See comment on stream-set-cursor-position
 (defmethod stream-ensure-cursor-visible ((stream output-protocol-mixin)
 					 &optional cx cy)
   (when (and (or (not (output-recording-stream-p stream))
 		 (stream-drawing-p stream))
 	     (pane-scroller stream))
-    (unless cy (multiple-value-setq (cx cy) (stream-cursor-position* stream)))
+    (unless cy (multiple-value-setq (cx cy) (stream-cursor-position stream)))
     (let ((viewport (pane-viewport-region stream))
 	  (new-x nil)
 	  (new-y nil)
@@ -416,11 +434,11 @@
 	;; If the cursor moves outside the current region, expand
 	;; it to include the new cursor position.
 	(when (> cy (bounding-rectangle-height stream))
-	  (update-region stream 
-			 (bounding-rectangle-min-x stream)
-			 (bounding-rectangle-min-y stream)
-			 cx 
-			 cy :no-repaint t))
+   	  (update-region stream 
+ 			 (bounding-rectangle-min-x stream)
+ 			 (bounding-rectangle-min-y stream)
+ 			 cx cy
+			 :no-repaint t))
 	(when (or new-x new-y)
 	  (scroll-extent stream :x (or new-x vleft) :y (or new-y vtop)))))))
 
@@ -673,11 +691,11 @@
   (declare (values last-x largest-x last-y total-height baseline))
   (unless end (setf end (length string)))
   (let ((style (or text-style (medium-merged-text-style stream)))
-	(cursor-x 0)
-	(cursor-y 0)
-	(height 0)
-	(baseline 0)
-	(largest-x 0))
+	(cursor-x (coordinate 0))
+	(cursor-y (coordinate 0))
+	(height (coordinate 0))
+	(baseline (coordinate 0))
+	(largest-x (coordinate 0)))
     (declare (type coordinate cursor-x cursor-y height baseline largest-x))
     (let (#+Silica (medium (sheet-medium stream)))
       (loop
@@ -685,9 +703,7 @@
 	(multiple-value-bind (write-char next-char-index new-cursor-x new-baseline new-height)
 	    (stream-scan-string-for-writing stream #+Silica medium
 					    string start end style
-					    ;;--- MOST-POSITIVE-FIXNUM will
-					    ;;--- lose, use a big single-float
-					    cursor-x most-positive-fixnum)
+					    cursor-x +largest-coordinate+)
 	  (declare (type coordinate new-cursor-x new-baseline new-height))
 	  (maxf largest-x new-cursor-x)
 	  (maxf baseline new-baseline)
@@ -699,9 +715,7 @@
 		  ((or (graphic-char-p write-char) (diacritic-char-p write-char))
 		   (multiple-value-bind (no-wrap new-cursor-x new-baseline new-height)
 		       (stream-scan-character-for-writing stream character style
-							  ;;--- MOST-POSITIVE-FIXNUM will
-							  ;;--- lose, use a big single-float
-							  cursor-x most-positive-fixnum)
+							  cursor-x +largest-coordinate+)
 		     (declare (ignore no-wrap))
 		     (maxf largest-x new-cursor-x)
 		     (maxf baseline new-baseline)
@@ -709,9 +723,9 @@
 		     (setf cursor-x new-cursor-x)))
 		  ((or (eql write-char #\Newline)
 		       (eql write-char #\Return))
-		   (setf cursor-x 0)
+		   (setf cursor-x (coordinate 0))
 		   (incf cursor-y height)
-		   (setf baseline 0
+		   (setf baseline (coordinate 0)
 			 height (stream-line-height stream style)))
 		  ((eql write-char #\Tab)
 		   (setf cursor-x (stream-next-tab-column stream cursor-x style))
@@ -720,9 +734,7 @@
 		   (multiple-value-bind (new-cursor-x new-cursor-y new-baseline new-height)
 		       (stream-draw-lozenged-character 
 			 stream write-char cursor-x cursor-y baseline height text-style
-			 ;;--- MOST-POSITIVE-FIXNUM will
-			 ;;--- lose, use a big single-float
-			 most-positive-fixnum nil nil)
+			 +largest-coordinate+ nil nil)
 		     (setf cursor-x new-cursor-x cursor-y new-cursor-y
 			   baseline new-baseline height new-height))))
 	    (incf start)))))
@@ -746,10 +758,10 @@
 	     (values bb-x bb-y)))
 	  ((or (eql character #\Newline)
 	       (eql character #\Return))
-	   (values (- (stream-cursor-position* stream))
+	   (values (- (stream-cursor-position stream))
 		   (stream-line-height stream style)))
 	  ((eql character #\Tab)
-	   (let ((here (stream-cursor-position* stream)))
+	   (let ((here (stream-cursor-position stream)))
 	     (- (stream-next-tab-column stream here style) here)))
 	  (t (cerror "Continue without drawing the character"
 		     "Can't yet draw lozenged characters: ~@C" character)))))
@@ -821,7 +833,7 @@
 (defmethod decode-stream-for-writing ((stream output-protocol-mixin) &optional brief-p)
   (declare (values cursor-x cursor-y baseline line-height
 		   style max-x record-p draw-p glyph-buffer))
-  (multiple-value-bind (cursor-x cursor-y) (stream-cursor-position* stream)
+  (multiple-value-bind (cursor-x cursor-y) (stream-cursor-position stream)
     (let ((baseline (stream-baseline stream))
 	  (line-height (stream-current-line-height stream))
 	  (wrap-p (unless brief-p (eq (stream-end-of-line-action stream) ':wrap))))
@@ -831,16 +843,14 @@
 		  (medium-merged-text-style stream)
 		  (cond ((and wrap-p
 			      (stream-text-margin stream)))
-			;;--- MOST-POSITIVE-FIXNUM will
-			;;--- lose, use a big single-float
-			(t most-positive-fixnum))
+			(t +largest-coordinate+))
 		  (stream-recording-p stream)
 		  (stream-drawing-p stream)
 		  (stream-output-glyph-buffer stream))))))
 
 (defmethod encode-stream-after-writing ((stream output-protocol-mixin) cursor-x cursor-y
 					baseline line-height)
-  (stream-set-cursor-position*-internal stream cursor-x cursor-y)
+  (stream-set-cursor-position-internal stream cursor-x cursor-y)
   (setf (stream-baseline stream) baseline
 	(stream-current-line-height stream) line-height))
 
@@ -872,8 +882,8 @@
 ;;; translation is done, and STREAM-WRITE-STRING-1 will be called with the
 ;;; original string, not the glyph buffer.
 (defmacro stream-scan-string-for-writing-body ()
-  '(let ((baseline 0)
-	 (height 0)
+  '(let ((baseline (coordinate 0))
+	 (height (coordinate 0))
 	 (our-font nil)
 	 (next-glyph (if (and glyph-buffer (array-has-fill-pointer-p glyph-buffer))
 			 (fill-pointer glyph-buffer)
@@ -904,15 +914,13 @@
 	       #-Silica stream #+Silica medium 
 	       character style our-font)
 	   (declare (ignore escapement-y origin-x bb-x))
-	   (declare (fixnum index))
-	   (declare (type coordinate origin-y bb-y))
+	   (declare (type fixnum index)
+		    (type coordinate origin-y bb-y))
 	   (when fixed-width-font-p
 	     (let* ((room-left (- max-x cursor-x *character-wrap-indicator-width*))
 		    (spaces-left (floor room-left escapement-x))
 		    (chars-left (- end start))
 		    (glyphs-left
-			;;--- MOST-POSITIVE-FIXNUM will
-			;;--- lose, use a big single-float
 		      (if max-glyph (- max-glyph next-glyph) most-positive-fixnum))
 		    (chars-to-do (min spaces-left chars-left glyphs-left))
 		    (chars-done 0)
@@ -962,7 +970,7 @@
 					   cursor-x max-x &optional glyph-buffer)
   (declare (values write-char next-char-index new-cursor-x new-baseline new-height font))
   (declare (type coordinate cursor-x max-x))
-  (declare (fixnum start end))
+  (declare (type fixnum start end))
   (stream-scan-string-for-writing-body))
 
 ;;; This function returns NIL as its first value if the character won't
@@ -1009,6 +1017,9 @@
   (let ((tab-size (stream-tab-size stream style)))
     (* tab-size (ceiling (1+ cursor-x) tab-size))))
 
+
+;;; Genera hooks
+
 #+Genera
 (defmethod stream-compatible-output-as-presentation-1
 	   ((stream output-protocol-mixin)
@@ -1057,6 +1068,38 @@
       (with-text-style (stream new-style)
 	(declare (ignore stream))
 	(funcall continuation xstream))))
+
+#+Genera
+;; Allows outputting a fat string to a CLIM stream
+(defmethod stream-write-string :around ((stream output-protocol-mixin) string
+					&optional (outer-start 0) outer-end)
+  (unless outer-end
+    (setq outer-end (length string)))
+  (unless (and (> outer-end outer-start) (scl:string-fat-p string))
+    (return-from stream-write-string (call-next-method)))
+  (let ((string string))
+      (declare (sys:array-register string))
+      (loop for start = outer-start then end
+	    while start
+	    as char = (char string start)
+	    as style = (si:char-style char)
+	    as end = (position style string
+			       :test-not #'eql :key #'si:char-style
+			       :start start :end outer-end)
+	    do
+	(scl:with-character-style (style stream)
+	  (call-next-method
+	    stream
+	    (scl:string-thin string :start start :end (or end outer-end)))))))
+
+#+Genera
+;; Allows outputting a fat character to a CLIM stream
+(defmethod stream-write-char :around ((stream output-protocol-mixin) character)
+  (unless (scl:char-fat-p character)
+    (return-from stream-write-char (call-next-method)))
+  (scl:with-character-style ((si:char-style character) stream)
+    (call-next-method stream (si:strip-style character))))
+
 
 ;;; Input Editor support.  This does STREAM-SCAN-STRING-FOR-WRITING and
 ;;; other stuff, and calls the continuation so the Input Editor can know
@@ -1072,7 +1115,8 @@
   (let ((vsp (stream-vertical-spacing stream))
 	#+Silica (medium (sheet-medium stream)))
     (loop
-      (when (>= start end) (return (values cursor-x cursor-y height baseline)))
+      (when (>= start end)
+	(return (values cursor-x cursor-y height baseline)))
       (multiple-value-bind (write-char next-char-index new-cursor-x new-baseline new-height)
 	  (stream-scan-string-for-writing stream #+Silica medium
 					  string start end style
@@ -1089,7 +1133,9 @@
 		   (eql write-char #\Newline)
 		   (eql write-char #\Return))
 	       (incf cursor-y (+ height vsp))
-	       (setf height 0 cursor-x 0 baseline 0)
+	       (setf height (coordinate 0)
+		     cursor-x (coordinate 0)
+		     baseline (coordinate 0))
 	       ;; If we wrapped, rescan the character normally, but if this is a newline
 	       ;; we're done with it.
 	       (when (or (eql write-char #\Newline)
@@ -1103,7 +1149,9 @@
 	       (let ((new-cursor-x (stream-next-tab-column stream cursor-x style)))
 		 (when (> (+ new-cursor-x *character-wrap-indicator-width*) max-x)
 		   (incf cursor-y (+ height vsp))
-		   (setf height 0 cursor-x 0 baseline 0)
+		   (setf height (coordinate 0)
+			 cursor-x (coordinate 0)
+			 baseline (coordinate 0))
 		   (setf new-cursor-x (stream-next-tab-column stream cursor-x style)))
 		 (funcall continuation cursor-x cursor-y
 				       new-cursor-x (+ cursor-y height vsp) baseline)
diff --git a/clim/output-recording-protocol.lisp b/clim/output-recording-protocol.lisp
deleted file mode 100644
index c272a05f..00000000
--- a/clim/output-recording-protocol.lisp
+++ /dev/null
@@ -1,1852 +0,0 @@
-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
-
-;; $fiHeader: output-recording-protocol.lisp,v 1.5 92/01/31 14:58:28 cer Exp Locker: cer $
-
-(in-package :clim-internals)
-
-"Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved.
- Portions copyright (c) 1989, 1990 International Lisp Associates."
-
-;; The protocol class for an object that obeys the output record protocol,
-;; that is, can hold output record elements
-(define-protocol-class output-record (bounding-rectangle))
-
-;; The protocol class for output records that are leaves.
-(define-protocol-class displayed-output-record (bounding-rectangle))
-
-;; The protocol class for textual displayed output records.
-(define-protocol-class text-displayed-output-record (displayed-output-record))
-
-;; The protocol class for graphical displayed output records.
-(define-protocol-class graphics-displayed-output-record (displayed-output-record))
-
-
-;;; A mix-in for classes that can be stored by other output records
-;;; OUTPUT-RECORD-ELEMENT-MIXIN has slots for
-;;;     (bounding rectangle, parent, start-position, end-position, contents-ok)
-;;;     plus space to store old bounding rectangle and position for incremental redisplay
-;;;  graphics output records
-;;;  text output records
-;;;  OUTPUT-RECORD-MIXIN has slots for (generation-tick, old-children)
-;;;      both used for incremental redisplay.
-;;;   STANDARD-SEQUENCE-OUTPUT-RECORD
-;;;    table, row, column, cell, presentation
-;;;   STANDARD-TREE-OUTPUT-RECORD
-;;;   KD-TREE-OUTPUT-RECORD (someday)
-
-;;; The output-record-element "protocol"
-;;;   :x-position, :y-position, :parent init args.
-;;;   bounding rectangle protocol
-
-;;; The output record protocol:
-;;;  output-record-children: (record)
-;;;  add-output-record: (child record)
-;;;  delete-output-record: (child record)
-;;;  clear-output-record: (record)
-;;;  replay-output-record: (record stream &optional region (x-offset 0) (y-offset 0)
-;;;  recompute-extent: (record)
-;;;  recompute-extent-for-new-child (there's a default): (record child)
-;;;  recompute-extent-for-changed-child: (record child)
-;;;  map-over-output-records-overlapping-region:
-;;;   (function record region
-;;;    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
-;;;  map-over-output-records-containing-point*:
-;;;   (function record x y
-;;;    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
-
-;;; The incremental redisplay protocol:
-;;;  see file incremental-redisplay-protocol.text, and incremental-redisplay.lisp.
-;;;
-
-;; Bounding rectangle position and set-position are in relative coordinates, 
-;;   relative to (OUTPUT-RECORD-POSITION* (OUTPUT-RECORD-PARENT RECORD)).
-;; The bounding rectangle measures just the ink.
-;; (OUTPUT-RECORD-START-CURSOR-POSITION* RECORD) refers to the position of the
-;; cursor at the start of RECORD.  It is also the origin of the
-;; coordinate system for all children of RECORD.
-(defclass output-record-element-mixin (standard-bounding-rectangle)
-    ;; start position is relative to the parent's start-position
-    ;; start position is where the cursor was when the new
-    ;; output-record was started.
-    ((start-x :initform 0 :initarg :start-x)
-     (start-y :initform 0 :initarg :start-y)
-     ;; end position is relative to start position.
-     ;; end position is where the cursor was when we finished the
-     ;; output-record.
-     (end-x :initform 0 :initarg :end-x)
-     (end-y :initform 0 :initarg :end-y)
-     ;; old-start-position is relative to old-start-position of parent
-     (old-start-x :initform 0)
-     (old-start-y :initform 0)
-     ;; old bounding rectangle is relative to parents' old-start-position.
-     (old-bounding-rectangle :initform nil
-			     :accessor output-record-old-bounding-rectangle)
-     (contents-ok :initform nil :accessor output-record-contents-ok)
-     (parent :accessor output-record-parent :initarg :parent)
-     (stream :initform nil :accessor output-record-stream))
-  (:default-initargs :parent nil :left 0 :top 0 :right 0 :bottom 0))
-
-;;; Give initial rectangle of 0 size, it will get expanded as children are added.
-(defmethod initialize-instance :after ((record output-record-element-mixin)
-				       &key (x-position 0) (y-position 0))
-  (with-slots (left top right bottom) record
-    (setf left x-position
-	  top  y-position
-	  right  x-position
-	  bottom y-position)))
-
-;;; Shadow the method on RECTANGLE with this one that keeps the start-position and 
-;;; bounding rectangle in synch.
-(defmethod bounding-rectangle-set-position* ((record output-record-element-mixin) nx ny)
-  (declare (type coordinate nx ny))
-  (with-slots (left top right bottom start-x start-y parent) record
-    (declare (type coordinate left top right bottom start-x start-y))
-    ;; Move the start position by as much as we do the record.
-    (setq start-x (+ start-x (- nx left)))
-    (setq start-y (+ start-y (- ny top)))
-    (let ((width (- right left))
-	  (height (- bottom top)))
-      (setf left nx top ny)
-      (setf right  (+ nx width)
-	    bottom (+ ny height)))))
-
-
-#+ignore
-(defmethod bounding-rectangle-set-position* :around ((record output-record-element-mixin) nx ny)
-  (with-bounding-rectangle* (x1 y1 x2 y2) record
-    (call-next-method)
-    (note-output-record-moved record (- nx x1) (- ny y1) (- nx x2) (- ny y2))))
-
-
-#+ignore
-(defmethod bounding-rectangle-set-edges :around ((record output-record-element-mixin) 
-						 left top right bottom)
-  (with-bounding-rectangle* (x1 y1 x2 y2) record
-    (call-next-method)
-    (note-output-record-moved record (- left x1) (- top y1) (- right x2) (- bottom y2))))
-
-
-#+Silica
-(defmethod note-output-record-moved ((record output-record-element-mixin) dx1 dy1 dx2 dy2)
-  (declare (ignore dx1 dy1 dx2 dy2))
-  nil)
-
-(defun-inline output-record-position* (record)
-  (output-record-start-cursor-position* record))
-
-;; X and Y had better be fixnums
-;;--- Coerce to COORDINATE
-(defmethod output-record-set-position* ((record output-record-element-mixin) x y)
-  (declare (type coordinate x y))
-  (bounding-rectangle-set-position* record x y))
-
-(defmethod output-record-start-cursor-position ((record output-record-element-mixin))
-  (with-slots (start-x start-y) record
-    (make-point start-x start-y)))
-
-(defmethod output-record-start-cursor-position* ((record output-record-element-mixin))
-  (with-slots (start-x start-y) record
-    (values start-x start-y)))
-
-;;; Keep the start-position and bounding rectangle in synch
-(defmethod output-record-set-start-cursor-position*
-	   ((record output-record-element-mixin) nx ny)
-  (declare (type coordinate nx ny))
-  (with-slots (start-x start-y) record
-    (declare (type coordinate start-x start-y))
-    (with-bounding-rectangle* (left top right bottom) record
-      (let ((dx (- nx start-x))
-	    (dy (- ny start-y)))
-	(bounding-rectangle-set-edges 
-	  record
-	  (+ left dx) (+ top dy) (+ right dx) (+ bottom dy))
-	(setf start-x nx start-y ny)))))
-
-(defmethod output-record-end-cursor-position* ((record output-record-element-mixin))
-  (with-slots (end-x end-y) record
-    (values end-x end-y)))
-  
-(defmethod output-record-set-end-cursor-position* ((record output-record-element-mixin) nx ny)
-  (declare (type coordinate nx ny))
-  (with-slots (end-x end-y) record
-    (setf end-x nx)
-    (setf end-y ny)))
-
-(defmethod output-record-old-start-cursor-position ((record output-record-element-mixin))
-  (with-slots (old-start-x old-start-y) record
-    (make-point old-start-x old-start-y)))
-
-(defmethod output-record-old-start-cursor-position* ((record output-record-element-mixin))
-  (with-slots (old-start-x old-start-y) record
-    (values old-start-x old-start-y)))
-
-(defmethod output-record-set-old-start-cursor-position*
-	   ((record output-record-element-mixin) nx ny)
-  (declare (type coordinate nx ny))
-  (with-slots (old-start-x old-start-y) record
-    (setf old-start-x nx)
-    (setf old-start-y ny)))
-
-#+CLIM-1-compatibility
-(progn
-(define-compatibility-function (output-record-start-position
-				output-record-start-cursor-position)
-			       (record)
-  (output-record-start-cursor-position record))
-
-(define-compatibility-function (output-record-start-position*
-				output-record-start-cursor-position*)
-			       (record)
-  (output-record-start-cursor-position* record))
-
-(define-compatibility-function (output-record-set-start-position*
-				output-record-set-start-cursor-position*)
-			       (record nx ny)
-  (output-record-set-start-cursor-position* record nx ny))
-
-(define-compatibility-function (output-record-end-position*
-				output-record-end-cursor-position*)
-			       (record)
-  (output-record-end-cursor-position* record))
-
-(define-compatibility-function (output-record-set-end-position*
-				output-record-set-end-cursor-position*)
-			       (record nx ny)
-  (output-record-set-end-cursor-position* record nx ny))
-)	;#+CLIM-1-compatibility
-
-
-(defmethod output-record-children ((record output-record-element-mixin))
-  nil)
-
-;;; For specialization by PRESENTATIONs, for example
-(defmethod output-record-refined-sensitivity-test ((record output-record-element-mixin) x y)
-  (declare (ignore x y))
-  T)
-
-(defun compute-output-record-offsets (record)
-  (let ((parent (output-record-parent record)))
-    (if (null parent)
-	(values 0 0)
-      (multiple-value-bind (x y)
-	  (compute-output-record-offsets parent)
-	(declare (type coordinate x y))
-	(multiple-value-bind (our-x our-y) (output-record-position* record)
-	  (declare (type coordinate our-x our-y))
-	  (values (+ our-x x) (+ our-y y)))))))
-
-(defmethod region-equal
-	   ((record1 output-record-element-mixin) (record2 output-record-element-mixin))
-  (with-bounding-rectangle* (left1 top1 right1 bottom1) record1
-    (with-bounding-rectangle* (left2 top2 right2 bottom2) record2
-      (if (eq (output-record-parent record1) (output-record-parent record2))
-	  (ltrb-equals-ltrb-p left1 top1 right1 bottom1
-			      left2 top2 right2 bottom2)
-	(multiple-value-bind (xoff1 yoff1) (compute-output-record-offsets record1)
-	  (declare (type coordinate xoff1 yoff1))
-	  (multiple-value-bind (xoff2 yoff2) (compute-output-record-offsets record2)
-	    (declare (type coordinate xoff2 yoff2))
-	    (translate-fixnum-positions xoff1 yoff1 left1 top1 right1 bottom1)
-	    (translate-fixnum-positions xoff2 yoff2 left2 top2 right2 bottom2)
-	    (ltrb-equals-ltrb-p left1 top1 right1 bottom1
-				left2 top2 right2 bottom2)))))))
-
-(defmethod region-contains-point*-p
-	   ((record output-record-element-mixin) x y)
-  (with-bounding-rectangle* (left top right bottom) record
-    (multiple-value-bind (xoff yoff) (compute-output-record-offsets record)
-      (declare (type coordinate xoff yoff))
-      (ltrb-contains-point*-p left top right bottom
-			      (+ x xoff) (+ y yoff)))))
-
-(defmethod region-contains-region-p
-	   ((record1 output-record-element-mixin) (record2 output-record-element-mixin))
-  (with-bounding-rectangle* (left1 top1 right1 bottom1) record1
-    (with-bounding-rectangle* (left2 top2 right2 bottom2) record2
-      (if (eq (output-record-parent record1) (output-record-parent record2))
-	  (ltrb-contains-ltrb-p left1 top1 right1 bottom1
-				left2 top2 right2 bottom2)
-	(multiple-value-bind (xoff1 yoff1) (compute-output-record-offsets record1)
-	  (declare (type coordinate xoff1 yoff1))
-	  (multiple-value-bind (xoff2 yoff2) (compute-output-record-offsets record2)
-	    (declare (type coordinate xoff2 yoff2))
-	    (translate-fixnum-positions xoff1 yoff1 left1 top1 right1 bottom1)
-	    (translate-fixnum-positions xoff2 yoff2 left2 top2 right2 bottom2)
-	    (ltrb-contains-ltrb-p left1 top1 right1 bottom1
-				  left2 top2 right2 bottom2)))))))
-
-(defmethod region-intersects-region-p
-	   ((record1 output-record-element-mixin) (record2 output-record-element-mixin))
-  (with-bounding-rectangle* (left1 top1 right1 bottom1) record1
-    (with-bounding-rectangle* (left2 top2 right2 bottom2) record2
-      (if (eq (output-record-parent record1) (output-record-parent record2))
-	  (ltrb-overlaps-ltrb-p left1 top1 right1 bottom1
-				left2 top2 right2 bottom2)
-	(multiple-value-bind (xoff1 yoff1) (compute-output-record-offsets record1)
-	  (declare (type coordinate xoff1 yoff1))
-	  (multiple-value-bind (xoff2 yoff2) (compute-output-record-offsets record2)
-	    (declare (type coordinate xoff2 yoff2))
-	    (translate-fixnum-positions xoff1 yoff1 left1 top1 right1 bottom1)
-	    (translate-fixnum-positions xoff2 yoff2 left2 top2 right2 bottom2)
-	    (ltrb-overlaps-ltrb-p left1 top1 right1 bottom1
-				  left2 top2 right2 bottom2)))))))
-
-(defun region-contains-offset-region-p (region1 region2 xoff yoff)
-  (declare (type coordinate xoff yoff))
-  (with-bounding-rectangle* (left1 top1 right1 bottom1) region1
-    (with-bounding-rectangle* (left2 top2 right2 bottom2) region2
-      (ltrb-contains-ltrb-p left1 top1 right1 bottom1
-			    (+ left2 xoff) (+ top2 yoff) (+ right2 xoff) (+ bottom2 yoff)))))
-
-(defun region-intersects-offset-region-p (region1 region2 xoff yoff)
-  (declare (type coordinate xoff yoff))
-  (with-bounding-rectangle* (left1 top1 right1 bottom1) region1
-    (with-bounding-rectangle* (left2 top2 right2 bottom2) region2
-      (ltrb-overlaps-ltrb-p left1 top1 right1 bottom1
-			    (+ left2 xoff) (+ top2 yoff) (+ right2 xoff) (+ bottom2 yoff)))))
-
-(defun offset-region-contains-point*-p (region xoff yoff x y)
-  (declare (type coordinate xoff yoff x y))
-   (with-bounding-rectangle* (left top right bottom) region
-     (ltrb-contains-point*-p (+ left xoff) (+ top yoff) (+ right xoff) (+ bottom yoff)
-			     x y)))
-
-;;; This maps over all of the children of the record
-#+Genera (zwei:defindentation (map-over-output-records 1 1))
-(defun map-over-output-records (function record
-				&optional (x-offset 0) (y-offset 0)
-				&rest continuation-args)
-  (declare (dynamic-extent function continuation-args))
-  (apply #'map-over-output-records-overlapping-region
-	 function record nil x-offset y-offset continuation-args))
-
-#+CLIM-1-compatibility
-(define-compatibility-function (map-over-output-record-elements
-				map-over-output-records)
-			       (record function
-				&optional x-offset y-offset &rest continuation-args)
-  (declare (dynamic-extent function continuation-args))
-  (apply #'map-over-output-records
-	 function record x-offset y-offset continuation-args))
-
-;;; This must map over the children in such a way that, when it maps over
-;;; overlapping children, the topmost (most recently inserted) child is
-;;; hit last.  This is because this function is used for things such as
-;;; replaying, where the most recently drawn thing must come out on top
-;;; (i.e., must be drawn last).  If the region is NIL, then this maps over
-;;; all of the children in the output record.
-#+Genera (zwei:defindentation (map-over-output-records-overlapping-region 2 1))
-(defgeneric map-over-output-records-overlapping-region
-	    (function record region
-	     &optional x-offset y-offset &rest continuation-args)
-  (declare (dynamic-extent function continuation-args)))
-
-#+CLIM-1-compatibility
-(define-compatibility-function (map-over-output-record-elements-overlapping-region
-				map-over-output-records-overlapping-region)
-			       (record region function
-				&optional x-offset y-offset &rest continuation-args)
-  (declare (dynamic-extent function continuation-args))
-  (apply #'map-over-output-records-overlapping-region
-	 function record region x-offset y-offset continuation-args))
-
-;;; This must map over the children in such a way that, when it maps over
-;;; overlapping children, the topmost (most recently inserted) child is
-;;; hit first, that is, the opposite order of MAP-...-OVERLAPPING-REGION.
-;;; This is because this function is used for things like locating the
-;;; presentation under the pointer, where the topmost thing wants to be
-;;; located first.
-#+Genera (zwei:defindentation (map-over-output-records-containing-point* 3 1))
-(defgeneric map-over-output-records-containing-point*
-	    (function record x y
-	     &optional x-offset y-offset &rest continuation-args)
-  (declare (dynamic-extent function continuation-args)))
-
-#+CLIM-1-compatibility
-(define-compatibility-function (map-over-output-record-elements-containing-point*
-				map-over-output-records-containing-point*)
-			       (record x y function
-				&optional x-offset y-offset &rest continuation-args)
-  (declare (dynamic-extent function continuation-args))
-  (apply #'map-over-output-records-containing-point*
-	 function record x y x-offset y-offset continuation-args))
-
-;;; X-offset and Y-offset represent the accumulated offset between the
-;;; regions's native coordinates and "our" coordinates and must be added
-;;; to our local coordinates (or subtracted from the region, if
-;;; possible) in order to validly compare them.
-;;; 
-;;; In the absence of x- and y- offsets, region should be in the
-;;; coordinate system of the record - i.e. relative to 
-;;;  (OUTPUT-RECORD-POSITION* RECORD).
-;;; This is the same coordinate system as the output record children
-;;; we are mapping over.
-(defmethod map-over-output-records-overlapping-region
-	   (function (record output-record-element-mixin) region
-	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
-  (declare (ignore region function x-offset y-offset continuation-args)
-	   (dynamic-extent function continuation-args))
-  nil)
-
-(defmethod map-over-output-records-containing-point*
-	   (function (record output-record-element-mixin) x y
-	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
-  (declare (ignore x y function x-offset y-offset continuation-args)
-	   (dynamic-extent function continuation-args))
-  nil)
-
-(defmethod map-over-output-records-containing-point*
-	   (function (record t) x y
-	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
-  (declare (dynamic-extent function continuation-args))
-  (apply #'map-over-output-records-overlapping-region
-	 function record (make-point x y)
-	 x-offset y-offset continuation-args))
-
-;; If some coordinate is relative to a given output-record, then
-;; CONVERT-FROM-RELATIVE-TO-ABSOLUTE-COORDINATES returns an x,y offset
-;; to be ADDED to any coordinates relative to OUTPUT-RECORD to give you
-;; absolute coordinates.
-(defun convert-from-relative-to-absolute-coordinates (stream output-record)
-  (declare (values x-offset y-offset))
-  (cond ((null output-record)
-	 (values 0 0)) ;;---------------------------- Why?
-	((and stream
-	      (eql output-record (stream-current-output-record stream)))
-	 (let ((position (stream-output-history-position stream)))
-	   (values (point-x position) (point-y position))))
-	((null (output-record-parent output-record))
-	 (values 0 0))
-	(t
-	 (multiple-value-bind (x y)
-	     (convert-from-relative-to-absolute-coordinates
-	       stream (output-record-parent output-record))
-	   (declare (type coordinate x y))
-	   (multiple-value-bind (our-x our-y) (output-record-position* output-record)
-	     (declare (type coordinate our-x our-y))
-	     (values (+ our-x x) (+ our-y y)))))))
-
-;; If some coordinate is in absolute coordinates, then
-;; CONVERT-FROM-ABSOLUTE-TO-RELATIVE-COORDINATES returns an x,y offset
-;; to be ADDED to any absolute coordinates to give you coordinates
-;; relative to OUTPUT-RECORD.
-(defun convert-from-absolute-to-relative-coordinates (stream output-record)
-  (declare (values x-offset y-offset))
-  (cond ((eql output-record (stream-current-output-record stream))
-	 (let ((position (stream-output-history-position stream)))
-	   (values (- (point-x position)) (- (point-y position)))))
-	((null (output-record-parent output-record))
-	 (values 0 0))
-	(t
-	 (multiple-value-bind (x y)
-	     (convert-from-absolute-to-relative-coordinates
-	       stream (output-record-parent output-record))
-	   (declare (type coordinate x y))
-	   (multiple-value-bind (our-x our-y) (output-record-position* output-record)
-	     (declare (type coordinate our-x our-y))
-	     (values (- x our-x) (- y our-y)))))))
-
-;; if ANCESTOR is an output-record with DESCENDANT as a descendant
-;; output-record (member of the transitive closure of all children of
-;; ancestor) then:  CONVERT-FROM-ANCESTOR-TO-DESCENDANT-COORDINATES
-;; returns an x,y offset pair that can be ADDED to any coordinates
-;; relative to ANCESTOR in order to get coordinates relative to
-;; DESCENDANT.
-(defun convert-from-ancestor-to-descendant-coordinates (ancestor descendant)
-  (declare (values x-offset y-offset))
-  (cond ((eql descendant ancestor)
-	 (values 0 0))
-	((null descendant)
-	 (error "~S was not an ancestor of ~S" ancestor descendant))
-	(t
-	 (multiple-value-bind (x y)
-	     (convert-from-ancestor-to-descendant-coordinates
-	       ancestor (output-record-parent descendant))
-	   (declare (type coordinate x y))
-	   (multiple-value-bind (our-x our-y) (output-record-position* descendant)
-	     (declare (type coordinate our-x our-y))
-	     (values (- x our-x) (- y our-y)))))))
-
-;; if ANCESTOR is an output-record with DESCENDANT as a descendant
-;; output-record (member of the transitive closure of all children of
-;; ancestor) then:  CONVERT-FROM-DESCENDANT-TO-ANCESTOR-COORDINATES
-;; returns an x,y offset pair that can be ADDED to any coordinates
-;; relative to DESCENDANT in order to get coordinates relative to
-;; ANCESTOR.
-(defun convert-from-descendant-to-ancestor-coordinates (descendant ancestor)
-  (declare (values x-offset y-offset))
-  (cond ((eql descendant ancestor)
-	 (values 0 0))
-	((null descendant)
-	 (error "~s was not an ancestor of ~s" ancestor descendant))
-	(t
-	 (multiple-value-bind (x y)
-	     (convert-from-descendant-to-ancestor-coordinates
-	       (output-record-parent descendant) ancestor)
-	   (declare (type coordinate x y))
-	   (multiple-value-bind (our-x our-y) (output-record-position* descendant)
-	     (declare (type coordinate our-x our-y))
-	     (values (+ our-x x) (+ our-y y)))))))
-
-;; A mix-in for classes that can store other output records
-(defclass output-record-mixin ()
-     ;; OLD-CHILDREN is the list of >unmatched< output records from last
-     ;; redisplay pass.  if you implement your own FIND-INFERIOR-OUTPUT-RECORD,
-     ;; and iff you match from OLD-CHILDREN, you are required to remove the
-     ;; match from OLD-CHILDREN, probably by using DECACHE-INFERIOR-OUTPUT-RECORD.
-     ((old-children :initform nil :accessor output-record-old-children)
-      (generation-tick :initform 0 :initarg :generation-tick
-		       :accessor output-record-generation-tick)))
-
-(defmethod inferiors-never-overlap-p ((record output-record-mixin)) nil)
-
-#+Silica
-(defmethod note-output-record-moved :after ((record output-record-mixin) dx1 dy1 dx2 dy2)
-  (unless (= 0 dx1 dy1 dx2 dy2)
-    (map-over-output-records
-     #'(lambda (child)
-	 (note-output-record-moved child dx1 dy1 dx2 dy2))
-     record)))
-
-#+Silica
-(defmethod bounding-rectangle-set-position* :around ((record output-record-mixin) nx ny)
-  (multiple-value-bind (ox oy)
-      (output-record-position* record)
-    (call-next-method)
-    (when (or (/= ox nx) (/= oy ny))
-      (note-output-record-moved record 1 1 1 1))))
-
-#+Silica
-(defmethod bounding-rectangle-set-edges :around ((record output-record-mixin) 
-						 left top right bottom)
-  (declare (ignore  left top right bottom))
-  (multiple-value-bind (ox oy)
-      (output-record-position* record)
-    (call-next-method)
-    (multiple-value-bind (nx ny)
-	(output-record-position* record)
-      (when (or (/= ox nx) (/= oy ny))
-	(note-output-record-moved record 1 1 1 1)))))
-
-(defun with-output-record-1 (continuation stream record &optional abs-x abs-y)
-  ;; Close the text record before and after, 
-  (stream-close-text-output-record stream)
-  (let ((current-output-position
-	  (stream-output-history-position stream)))
-    (unless abs-y
-      (multiple-value-setq (abs-x abs-y)
-	(stream-cursor-position* stream)))
-    (letf-globally (((point-x current-output-position) abs-x)
-		    ((point-y current-output-position) abs-y)
-		    ((stream-current-output-record stream) record))
-      (funcall continuation record)
-      (multiple-value-bind (end-x end-y)
-	  (stream-cursor-position* stream)
-	(declare (type coordinate end-x end-y))
-	(output-record-set-end-cursor-position*
-	  record (- end-x abs-x) (- end-y abs-y)))
-      (stream-close-text-output-record stream))))
-
-;;; Rest of stuff started in clim-defs...
-(defun construct-output-record-1 (type &rest init-args)
-  (declare (dynamic-extent init-args))
-  (let ((constructor (gethash type *output-record-constructor-cache*)))
-    (if constructor
-	(apply constructor init-args)
-	(apply #'make-instance type init-args))))
-
-#||
-;;; A hash table associating vectors holding free output records.
-;;; The idea is to not cons on allocate/free, but be fast.
-(defvar *record-resource-table* (make-hash-table))
-(defvar *use-record-resources* nil)
-
-(defun allocate-record (type)
-  (when *use-record-resources*
-    (multiple-value-bind (record-vector found-p)
-	(gethash type *record-resource-table*)
-      (unless found-p
-	(setq record-vector
-	      (setf (gethash type *record-resource-table*)
-		    (make-array 20 :fill-pointer 0))))
-      (vector-pop record-vector))))
-
-(defun free-record (record)
-  (when *use-record-resources*
-    (let ((type (class-name (class-of record))))
-      (multiple-value-bind (record-vector found-p)
-	  (gethash type *record-resource-table*)
-	(unless found-p
-	  (setq record-vector
-		(setf (gethash type *record-resource-table*)
-		      (make-array 20 :fill-pointer 0))))
-	(setf (output-record-parent record) nil)
-	(vector-push-extend record record-vector)))))
-||#
-
-(defun invoke-with-new-output-record (stream continuation record-type constructor
-				      &rest init-args &key parent &allow-other-keys)
-  (declare (dynamic-extent init-args))
-  (with-keywords-removed (init-args init-args '(:parent))
-    (let* ((current-output-record (stream-current-output-record stream))
-	   (new-output-record (and (stream-redisplaying-p stream)
-				   current-output-record
-				   (apply #'find-inferior-output-record-1
-					  current-output-record record-type init-args))))
-      (multiple-value-bind (cursor-x cursor-y)
-	  (stream-cursor-position* stream)
-	(declare (type coordinate cursor-x cursor-y))
-	(multiple-value-bind (x y)
-	    (multiple-value-bind (px py)
-		(point-position*
-		  (stream-output-history-position stream))
-	      (declare (type coordinate px py))
-	      (position-difference* cursor-x cursor-y px py))
-	  (declare (type coordinate x y))
-	  (if new-output-record
-	      (copy-display-state new-output-record nil)
-	      (setq new-output-record
-		    ;;--- Used to call ALLOCATE-RECORD, then initialize by
-		    ;;--- setting the edges (or INITIALIZE-INSTANCE)
-		    (if constructor
-			(apply constructor
-			       :x-position x :y-position y init-args)
-			(apply #'construct-output-record-1 record-type
-			       :x-position x :y-position y init-args))))
-	  (output-record-set-start-cursor-position* new-output-record x y)
-	  (with-output-record-1 continuation 
-				stream new-output-record cursor-x cursor-y)
-	  (when (stream-redisplaying-p stream)
-	    (recompute-contents-ok new-output-record))
-	  ;; We set the parent after doing everything else so that calls
-	  ;; to RECOMPUTE-CONTENTS-OK inside the dynamic extent of the
-	  ;; continuation won't take forever.
-	  (let ((parent (or parent
-			    current-output-record
-			    (stream-output-history stream))))
-	    (when parent 
-	      (add-output-record new-output-record parent)))
-	  new-output-record)))))
-
-(defun invoke-with-room-for-graphics (stream continuation record-type move-cursor &key height)
-  (let ((record
-	  (with-output-recording-options (stream :draw nil :record t)
-	    (with-first-quadrant-coordinates (stream)
-	      (with-new-output-record (stream record-type)
-		(funcall continuation stream))))))
-    (multiple-value-bind (x y) (output-record-position* record)
-      (declare (type coordinate x y))
-      ;;--- Hey, there is something wierd going on here.  The problem is that
-      ;;--- OUTPUT-RECORD-POSITION* and OUTPUT-RECORD-SET-POSITION* seem to obey
-      ;;--- different coordinate system conventions.  Geez.
-      (when height
-	(incf y (- height (bounding-rectangle-height record))))
-      (output-record-set-position* record x y))
-    (tree-recompute-extent record)
-    (replay record stream)
-    (when move-cursor
-      (move-cursor-beyond-output-record stream record))
-    record))
-
-(defun replay (record stream &optional region)
-  (when (stream-drawing-p stream)
-    (multiple-value-bind (x-offset y-offset)
-	(convert-from-relative-to-absolute-coordinates stream (output-record-parent record))
-      ;; Output recording should be off, but let's be forgiving...
-      (letf-globally (((stream-recording-p stream) nil))
-	(replay-output-record record stream region x-offset y-offset)))))
-
-;; Replay all the the inferiors of RECORD that overlap REGION.
-(defmethod replay-output-record ((record output-record-mixin) stream
-				 &optional region (x-offset 0) (y-offset 0))
-  (declare (type coordinate x-offset y-offset))
-  ;;--- Doing things this way bypasses any REPLAY-OUTPUT-RECORD methods supplied on 
-  ;;--- non-standard classes that satisfy the output record protocol.
-  ;;--- Too bad, this relative coordinates stuff is a disaster anyway.
-  (labels ((replay-internal (record x-offset y-offset)
-	     (declare (type coordinate x-offset y-offset))
-	     (if (output-record-p record)
-		 (multiple-value-bind (xoff yoff) (output-record-position* record)
-		   (map-over-output-records-overlapping-region 
-		     #'replay-internal record region 
-		     (- x-offset) (- y-offset)
-		     (+ x-offset xoff) (+ y-offset yoff)))
-		 (replay-output-record record stream region x-offset y-offset))))
-    (declare (dynamic-extent #'replay-internal))
-    (replay-internal record x-offset y-offset)))
-
-(defun move-cursor-beyond-output-record (stream record)
-  (multiple-value-bind (x-offset y-offset)
-      (convert-from-relative-to-absolute-coordinates
-	stream (output-record-parent record))
-    (declare (type coordinate x-offset y-offset))
-    (with-bounding-rectangle* (left top right bottom) record
-      (declare (ignore left top))
-      (with-end-of-page-action (stream :allow)
-	(stream-set-cursor-position*
-	  stream
-	  (+ right x-offset) (- (+ bottom y-offset) (stream-line-height stream)))))))
-
-(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))))))
-
-(defmethod recompute-extent ((record output-record-mixin))
-  (with-slots (parent) record
-    (with-bounding-rectangle* (old-left old-top old-right old-bottom) record
-      (let ((once nil)
-	    (min-x 0) (min-y 0) (max-x 0) (max-y 0))
-	(declare (type coordinate min-x min-y max-x max-y))
-	(flet ((recompute-extent-of-child (child)
-		 (with-bounding-rectangle* (left top right bottom) child
-		   (cond (once
-			  (minf min-x left)
-			  (minf min-y top)
-			  (maxf max-x right)
-			  (maxf max-y bottom))
-			 (t
-			  (setq min-x left
-				min-y top
-				max-x right
-				max-y bottom
-				once  t))))))
-	  (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)
-	  (declare (type coordinate xoff yoff))
-	  (if once
-	      (progn (assert (ltrb-well-formed-p min-x min-y max-x max-y))
-		     (bounding-rectangle-set-edges
-		       record
-		       (+ min-x xoff) (+ min-y yoff)
-		       (+ max-x xoff) (+ max-y yoff)))
-	      ;; No children
-	      (bounding-rectangle-set-edges record 0 0 0 0))
-	  ;; Pass these coordinates in parent's coordinate system (I think)
-	  (translate-fixnum-positions xoff yoff
-	    old-left old-top old-right old-bottom))
-	(when parent
-	  (recompute-extent-for-changed-child
-	    parent record old-left old-top old-right old-bottom))))))
-
-(defmethod recompute-extent-for-new-child ((record output-record-mixin) child)
-  (with-slots (parent) record
-    (with-bounding-rectangle* (left top right bottom) record
-      (let ((old-left left)
-	    (old-top top)
-	    (old-right right)
-	    (old-bottom bottom))
-	(with-bounding-rectangle* (eleft etop eright ebottom) child
-	  (multiple-value-bind (xoff yoff)
-	      (convert-from-descendant-to-ancestor-coordinates record parent)
-	    (translate-fixnum-positions xoff yoff
-	      eleft etop eright ebottom
-	      ;; pass these coordinates in parent's coordinate system.
-	      old-left old-top old-right old-bottom))
-	  (cond ((= (output-record-count record) 1)
-		 (bounding-rectangle-set-edges record eleft etop eright ebottom))
-		(t (bounding-rectangle-set-edges record
-						 (min left eleft) (min top etop)
-						 (max right eright) (max bottom ebottom)))))
-	(when parent
-	  (recompute-extent-for-changed-child
-	    parent record old-left old-top old-right old-bottom))))))
-
-;;; This is for adjusting extents after a bunch of leaves have been moved.
-(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-fixnum-positions xoff yoff old-left old-top old-right old-bottom))
-      (tree-recompute-extent-1 record)
-      (when parent
-	(recompute-extent-for-changed-child
-	  parent record old-left old-top old-right old-bottom)))))
-
-#+CLIM-1-compatibility
-(progn
-(define-compatibility-function (add-output-record-element add-output-record)
-			       (record child)
-  (add-output-record child record))
-
-(define-compatibility-function (delete-output-record-element delete-output-record)
-			       (record child &optional (errorp t))
-  (delete-output-record child record errorp))
-
-(define-compatibility-function (output-record-elements output-record-children)
-			       (record)
-  (output-record-children record))
-
-(define-compatibility-function (output-record-element-count output-record-count)n
-			       (record)
-  (output-record-count record))
-)	;#+CLIM-1-compatibility
-
-
-;;; Common to all implementations.
-;;; ADD-OUTPUT-RECORD assumes that CHILD's start-position and bounding 
-;;; rectangle have already been normalized to RECORD's coordinate system.
-(defmethod add-output-record :after (child (record output-record-mixin)) ;was :around
-  (setf (output-record-parent child) record)
-  (recompute-extent-for-new-child record child)
-  (when (output-record-stream record)
-    (note-output-record-attached child (output-record-stream record))))
-
-(defmethod note-output-record-attached ((record output-record-element-mixin) stream)
-  (setf (output-record-stream record) stream))
-
-(defmethod note-output-record-attached :after ((record output-record-mixin) stream)
-  (map-over-output-records
-   #'(lambda (rec)
-       (note-output-record-attached rec stream))
-   record))
-
-;;; Ditto.
-(defmethod delete-output-record :after
-	   (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-fixnum-positions 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.
-
-(defmethod delete-output-record :around (child (record output-record-mixin) &optional errorp)
-  (declare (ignore errorp))
-  (let ((stream (output-record-stream child)))
-    (multiple-value-prog1
-	(call-next-method)
-      (when stream
-	(note-output-record-detached child)))))
-
-
-(defmethod note-output-record-detached ((record output-record-element-mixin))
-  (setf (output-record-stream record) nil))
-
-(defmethod note-output-record-detached :after ((record output-record-mixin))
-  (map-over-output-records
-   #'note-output-record-detached
-   record))
-
-;;; Recurse down all inferiors returning them to the "resource" table.
-#+++Ignore
-(defmethod clear-output-record :before ((record output-record-mixin))
-	   (free-output-record record))
-
-;;; Invoked by CLEAR-OUTPUT-RECORD.
-#+++Ignore
-(defmethod free-output-record ((record output-record-element-mixin))
-  (free-record record)
-  (map-over-output-records #'free-output-record record))
-
-(defmethod clear-output-record :after ((record output-record-mixin))
-  (bounding-rectangle-set-edges record 0 0 0 0))
-
-(defmethod clear-output-record :around ((record output-record-mixin))
-  (when (output-record-stream record)
-    (map-over-output-records
-     #'note-output-record-detached
-     record))
-  (call-next-method))
-
-
-;;; Sequence output records store their children in a vector
-(defclass standard-sequence-output-record
-	  (output-record-mixin output-record-element-mixin output-record)
-    ((elements :initform nil)
-     (fill-pointer :initform 0 :type fixnum)))
-
-(define-output-record-constructor standard-sequence-output-record
-				  (&key x-position y-position (size 5))
-  :x-position x-position :y-position y-position :size size)
-
-(defmethod initialize-instance :after ((record standard-sequence-output-record) 
-				       &key (size 5))
-  ;; probably want to save size away somewhere so that the
-  ;; guy who actually makes the array can reference it...
-  (declare (ignore size))
-  ;; size defaults to very small to save space
-  ;; most dependent classes will have supplied default-initargs with better
-  ;; chosen default.
-  (with-slots (elements fill-pointer) record
-    ;; We run initialize-instance to re-initialize the record, so don't re-alloc the array
-    (etypecase elements
-      ((or null output-record displayed-output-record) (setf elements nil))
-      (array (setf fill-pointer 0)))))
-
-;;; For debugging.
-(defmethod output-record-children ((record standard-sequence-output-record))
-  (with-slots (elements fill-pointer) record
-    (typecase elements
-      (null nil)
-      (array
-	(let ((result (make-list fill-pointer)))
-	  (replace result elements :end1 fill-pointer :end2 fill-pointer)
-	  result))
-      ;; It must be an OUTPUT-RECORD or a DISPLAYED-OUTPUT-RECORD
-      (otherwise (list elements)))))
-
-(defmethod output-record-element ((record standard-sequence-output-record) index)
-  (with-slots (elements) record
-    (svref elements index)))
-
-(defmethod output-record-count ((record standard-sequence-output-record))
-  (with-slots (elements fill-pointer) record
-    (typecase elements
-      (null 0)
-      (array fill-pointer)
-      ;; It must be an OUTPUT-RECORD or a DISPLAYED-OUTPUT-RECORD
-      (otherwise 1))))
-
-(defmethod clear-output-record ((record standard-sequence-output-record))
-  (with-slots (elements fill-pointer) record
-    (typecase elements
-      (null nil)
-      (array (setf fill-pointer 0))
-      ;; It must be an OUTPUT-RECORD or a DISPLAYED-OUTPUT-RECORD
-      (otherwise (setf elements nil)))))
-
-(defmethod add-output-record (child (record standard-sequence-output-record))
-  (with-slots (elements fill-pointer) record
-    (typecase elements
-      (null
-	(setf elements child))
-      (array
-	(multiple-value-setq (elements fill-pointer)
-	  (simple-vector-push-extend child elements fill-pointer)))
-      ;; It must be an OUTPUT-RECORD or a DISPLAYED-OUTPUT-RECORD
-      (otherwise
-	(let ((first elements))
-	  (setf elements (make-array 5))
-	  (setf fill-pointer 2)
-	  (setf (svref elements 0) first)
-	  (setf (svref elements 1) child))))))
-
-(defmethod delete-output-record 
-	   (child (record standard-sequence-output-record) &optional (errorp t))
-  (with-slots (elements fill-pointer) record
-    (typecase elements
-      (null (error "The output record ~S was not found in ~S" child record))
-      (array
-	(let ((index (position child elements :end fill-pointer)))
-	  (cond (index
-		 (let ((new-fp (the fixnum (1- fill-pointer)))
-		       (vector elements))
-		   (declare (type simple-vector vector) (fixnum new-fp)
-			    #+Genera (sys:array-register vector))
-		   (unless (= (the fixnum index) new-fp)
-		     ;; Shift the whole vector downward
-		     (do ((i (the fixnum index) (1+ i)))
-			 ((= i new-fp))
-		       (declare (fixnum i) (optimize (speed 3) (safety 0)))
-		       (setf (svref vector i) (svref vector (1+ i)))))
-		   (setf fill-pointer new-fp)))
-		(errorp
-		 (error "The output record ~S was not found in ~S" child record)))))
-      ;; It must be an OUTPUT-RECORD or a DISPLAYED-OUTPUT-RECORD
-      (otherwise
-	(unless (eql elements child)
-	  (error "The output record ~S was not found in ~S" child record))
-	(setf elements nil))))
-  t)
-
-(defmethod map-over-output-records-overlapping-region
-	   (function (record standard-sequence-output-record) region  
-	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
-  (declare (dynamic-extent function continuation-args))
-  (declare (type coordinate x-offset y-offset))
-  (declare (optimize (safety 0)))
-  (with-slots (elements fill-pointer) record
-    (typecase elements
-      (null nil)
-      (array
-	(if (or (null region) (eql region +everywhere+))
-	    (dovector (child elements :start 0 :end fill-pointer :simple-p t)
-	      (apply function child continuation-args))
-	  (with-bounding-rectangle* (left1 top1 right1 bottom1) region
-	    (translate-fixnum-positions x-offset y-offset left1 top1 right1 bottom1)
-	    ;; Subtract out the record offset from the region, to make comparison fair
-	    (multiple-value-bind (xoff yoff)
-		(output-record-position* record)
-	      (translate-fixnum-positions (- xoff) (- yoff) left1 top1 right1 bottom1))
-	    (dovector (child elements :start 0 :end fill-pointer :simple-p t)
-	      (with-bounding-rectangle* (left2 top2 right2 bottom2) child
-		(when (ltrb-overlaps-ltrb-p left1 top1 right1 bottom1
-					    left2 top2 right2 bottom2)
-		  (apply function child continuation-args)))))))
-      (otherwise
-	(if (or (null region) (eql region +everywhere+))
-	    (apply function elements continuation-args)
-	  (multiple-value-bind (xoff yoff)
-	      (output-record-position* record)
-	    (declare (type coordinate xoff yoff))
-	    (when (region-intersects-offset-region-p
-		    elements region (- x-offset xoff) (- y-offset yoff))
-	      (apply function elements continuation-args)))))))
-  nil)
-
-(defmethod map-over-output-records-containing-point*
-	   (function (record standard-sequence-output-record) x y 
-	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
-  (declare (dynamic-extent function continuation-args))
-  (declare (type coordinate x y x-offset y-offset))
-  (declare (optimize (safety 0)))
-  (translate-fixnum-positions x-offset y-offset x y)
-  (with-slots (elements fill-pointer) record
-    (typecase elements
-      (null nil)
-      (array
-	(multiple-value-bind (xoff yoff)
-	    (output-record-position* record)
-	  (translate-fixnum-positions (- xoff) (- yoff) x y))
-	(dovector (child elements :start 0 :end fill-pointer :from-end t :simple-p t)
-	  (with-bounding-rectangle* (left top right bottom) child
-	    (when (ltrb-contains-point*-p left top right bottom x y)
-	      (apply function child continuation-args)))))
-      (otherwise
-	(multiple-value-bind (xoff yoff) (output-record-position* record)
-	  (when (offset-region-contains-point*-p elements xoff yoff x y)
-	    (apply function elements continuation-args))))))
-  nil)
-
-
-;;; Text line output recording.  A stream which does text output creates one of
-;;; these per line of text.  Lines are delimited by either #\RETURNs or by
-;;; wrapping.  Line boundaries are not recalculated when window size is changed; a
-;;; higher-level kind of output record is required for that (protocol not yet
-;;; defined, but should be obvious).
-
-;;; The string is a vector of those characters which were output on the current
-;;; line.  The initial-text-style is the very first style which
-;;; appeared on the line.  The current-text-style is the style of
-;;; the last character which appeared on the line.  The baseline is used to
-;;; determine where to draw the glyphs.
-
-;;; The text-style-changes is an NCONCed list of conses of the form
-;;; (style . position).  The characters between the beginning of the record
-;;; and the first change are in the initial-text-style.  Unfortunately,
-;;; you can't just use STREAM-WRITE-STRING-1 on the substring involved
-;;; because that function returns in the middle when it encounters a character it
-;;; can't deal with, such as tabs and non-graphic characters.  There should never
-;;; be a #\Return character in a STANDARD-TEXT-OUTPUT-RECORD.
-
-(defclass standard-text-output-record
-	  (output-record-element-mixin text-displayed-output-record)
-    ((string :initarg :string)
-     (wrapped-p :initform nil :initarg :wrapped-p)
-     (ink :initarg :ink)))
-
-(defclass styled-text-output-record
-	  (standard-text-output-record text-displayed-output-record)
-    ((initial-text-style :initform nil :initarg :initial-style)
-     (text-style-changes :initform nil)
-     (current-text-style :initform nil :initarg :current-style)
-     (baseline :initform 0 :initarg :baseline)))
-
-(define-constructor make-standard-text-output-record
-		    standard-text-output-record (ink string)
-		    :ink ink :string string)
-
-(define-constructor make-styled-text-output-record
-		    styled-text-output-record (ink string)
-		    :ink ink :string string)
-
-(define-constructor make-styled-text-output-record-1
-		    styled-text-output-record (ink string wrapped-p style baseline)
-  :ink ink :string string :wrapped-p wrapped-p
-  :initial-style style :current-style style :baseline baseline)
-
-(defmethod print-object ((object standard-text-output-record) stream)
-  (print-unreadable-object (object stream :type t :identity t)
-    (format stream "~S /x ~A:~A y ~A:~A/"
-	    (safe-slot-value object 'string)
-	    (safe-slot-value object 'left)
-	    (safe-slot-value object 'right)
-	    (safe-slot-value object 'top)
-	    (safe-slot-value object 'bottom))))
-
-(defmethod output-record-unique-id ((text standard-text-output-record))
-  (slot-value text 'string))
-
-(defmethod replay-output-record ((record standard-text-output-record) stream
-				 &optional region (x-offset 0) (y-offset 0))
-  (declare (type coordinate x-offset y-offset))
-  (declare (ignore region))
-  (let* ((string (slot-value record 'string))
-	 (start 0)
-	 (end (length string))
-	 (text-style (medium-default-text-style stream))
-	 (baseline (- (text-style-height text-style stream)
-		      (text-style-descent text-style stream)))
-	 (glyph-buffer (stream-output-glyph-buffer stream))
-	 (color (slot-value record 'ink)))
-    (declare (fixnum start end))
-    (#-Silica progn
-     #+Silica with-sheet-medium #+Silica (medium stream)
-     (macrolet
-      ((do-it (end-position)
-	 `(loop
-	    (when (>= start ,end-position) (return))
-	    (multiple-value-bind (write-char next-char-index
-				  new-cursor-x new-baseline new-height font)
-		(stream-scan-string-for-writing stream 
-						#+Silica medium
-						string start ,end-position
-						text-style cursor-x
-						;;--- MOST-POSITIVE-FIXNUM loses
-						most-positive-fixnum 
-						glyph-buffer)
-	      ;; GLYPH-BUFFER NIL => pass the string to the port-specific code.
-	      #-Silica
-	      (if glyph-buffer
-		  (stream-write-string-1
-		    stream glyph-buffer 0 (the fixnum (- next-char-index start))
-		    font color
-		    cursor-x (+ cursor-y (- baseline new-baseline)))
-		  (stream-write-string-1
-		    stream string start next-char-index
-		    font color
-		    cursor-x (+ cursor-y (- baseline new-baseline))))
-	      #+Silica
-	      (with-identity-transformation (medium)
-		(draw-text* medium string
-			    cursor-x (+ cursor-y (- baseline new-baseline))
-			    :start start :end next-char-index 
-			    :align-y :top
-			    :text-style text-style :ink color))
-	      (setf cursor-x new-cursor-x start next-char-index)
-	      (when write-char
-		(cond ((eql write-char #\Tab)	;Only non-lozenged exception char?
-		       (setf cursor-x (stream-next-tab-column stream cursor-x text-style)))
-		      (t 
-		       (multiple-value-bind (new-cursor-x new-cursor-y)
-			   (stream-draw-lozenged-character
-			     stream write-char cursor-x cursor-y new-baseline new-height
-			     ;;--- MOST-POSITIVE-FIXNUM loses
-			     text-style most-positive-fixnum nil t)
-			 (setf cursor-x new-cursor-x
-			       cursor-y new-cursor-y))))
-		(incf start))))))
-      (multiple-value-bind (cursor-x cursor-y) 
-	  (output-record-start-cursor-position* record)
-	(declare (type coordinate cursor-x cursor-y))
-	(translate-fixnum-positions x-offset y-offset cursor-x cursor-y)
-	(do-it end)
-	#-Silica
-	(when (slot-value record 'wrapped-p)
-	  (draw-character-wrap-indicator
-	    stream cursor-y (bounding-rectangle-height record) (stream-text-margin stream) nil)))))))
-
-(defmethod replay-output-record ((record styled-text-output-record) stream
-				 &optional region (x-offset 0) (y-offset 0))
-  (declare (type coordinate x-offset y-offset))
-  (declare (ignore region))
-  (let* ((string (slot-value record 'string))
-	 (start 0)
-	 (end (length string))
-	 (text-style (slot-value record 'initial-text-style))
-	 (baseline (slot-value record 'baseline))
-	 (glyph-buffer (stream-output-glyph-buffer stream))
-	 (color (slot-value record 'ink)))
-    (declare (fixnum start end))
-    (#-Silica progn
-     #+Silica with-sheet-medium #+Silica (medium stream)
-     (macrolet
-      ((do-it (end-position)
-	 `(loop
-	    (when (>= start ,end-position) (return))
-	    (multiple-value-bind (write-char next-char-index
-				  new-cursor-x new-baseline new-height font)
-		(stream-scan-string-for-writing stream 
-						#+Silica medium
-						string start ,end-position
-						text-style cursor-x
-						;;--- LOSES
-						most-positive-fixnum 
-						glyph-buffer)
-	      #-Silica
-	      (if glyph-buffer
-		  (stream-write-string-1
-		    stream glyph-buffer 0 (the fixnum (- next-char-index start))
-		    font color
-		    cursor-x (+ cursor-y (- baseline new-baseline)))
-		  (stream-write-string-1
-		    stream string start next-char-index
-		    font color
-		    cursor-x (+ cursor-y (- baseline new-baseline))))
-	      #+Silica
-	      (with-identity-transformation (medium)
-		(draw-text* medium string
-			    cursor-x (+ cursor-y (- baseline new-baseline))
-			    :start start :end next-char-index 
-			    :align-y :top
-			    :text-style text-style :ink color))
-	      (setf cursor-x new-cursor-x start next-char-index)
-	      (when write-char
-		(cond ((eql write-char #\Tab)	;Only non-lozenged exception char?
-		       (setf cursor-x (stream-next-tab-column stream cursor-x text-style)))
-		      (t 
-		       (multiple-value-bind (new-cursor-x new-cursor-y)
-			   (stream-draw-lozenged-character
-			     stream write-char cursor-x cursor-y new-baseline new-height
-			     ;;--- LOSES
-			     text-style most-positive-fixnum nil t)
-			 (setf cursor-x new-cursor-x
-			       cursor-y new-cursor-y))))
-		(incf start))))))
-      (multiple-value-bind (cursor-x cursor-y) 
-	  (output-record-start-cursor-position* record)
-	(declare (type coordinate cursor-x cursor-y))
-	(translate-fixnum-positions x-offset y-offset cursor-x cursor-y)
-	(dolist (text-style-change (slot-value record 'text-style-changes))
-	  (let ((new-text-style (car text-style-change))
-		(change-position (cdr text-style-change)))
-	    (do-it change-position)
-	    (setf text-style new-text-style
-		  start change-position)))
-	(do-it end)
-	#-Silica
-	(when (slot-value record 'wrapped-p)
-	  (draw-character-wrap-indicator
-	    stream cursor-y (bounding-rectangle-height record) 
-	    (stream-text-margin stream) nil)))))))
-
-(defmethod bounding-rectangle-set-edges :around
-	   ((record standard-text-output-record) new-left new-top new-right new-bottom)
-  (declare (ignore new-left new-top new-right new-bottom))
-  (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-fixnum-positions 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))))
-
-(defmethod add-string-output-to-text-record ((record standard-text-output-record)
-					     text-string start end text-style
-					     new-width new-height new-baseline)
-  (declare (ignore text-style new-baseline))
-  (declare (fixnum start end))
-  (when (>= start end)
-    (return-from add-string-output-to-text-record))
-  (let* ((count (the fixnum (- end start)))
-	 (string (prepare-text-record-for-appending record count nil))
-	 (fill-pointer (fill-pointer string)))
-    (multiple-value-bind (width height) (bounding-rectangle-size record)
-      (declare (type coordinate width height))
-      (setf (fill-pointer string) (the fixnum (+ fill-pointer count)))
-      (replace string text-string :start1 fill-pointer :start2 start :end2 end)
-      (incf width new-width)
-      (maxf height new-height)
-      (bounding-rectangle-set-size record width height))))
-
-(defmethod add-string-output-to-text-record ((record styled-text-output-record)
-					     text-string start end text-style
-					     new-width new-height new-baseline)
-  (declare (fixnum start end))
-  (when (>= start end)
-    (return-from add-string-output-to-text-record))
-  (let* ((count (the fixnum (- end start)))
-	 (string (prepare-text-record-for-appending record count text-style))
-	 (fill-pointer (fill-pointer string)))
-    (multiple-value-bind (width height) (bounding-rectangle-size record)
-      (declare (type coordinate width height))
-      (setf (fill-pointer string) (the fixnum (+ fill-pointer count)))
-      (replace string text-string :start1 fill-pointer :start2 start :end2 end)
-      (incf width new-width)
-      (maxf height new-height)
-      (maxf (slot-value record 'baseline) new-baseline)
-      (bounding-rectangle-set-size record width height))))
-
-(defmethod add-character-output-to-text-record ((record standard-text-output-record)
-						character text-style
-						new-width new-height new-baseline)
-  (declare (ignore text-style new-baseline))
-  (let* ((string (prepare-text-record-for-appending record 1 nil))
-	 (fill-pointer (fill-pointer string)))
-    (multiple-value-bind (width height) (bounding-rectangle-size record)
-      (declare (type coordinate width height))
-      (setf (fill-pointer string) (1+ fill-pointer)
-	    (aref string fill-pointer) character)
-      (incf width new-width)
-      (maxf height new-height)
-      (bounding-rectangle-set-size record width height))))
-
-(defmethod add-character-output-to-text-record ((record styled-text-output-record)
-						character text-style
-						new-width new-height new-baseline)
-  (let* ((string (prepare-text-record-for-appending record 1 text-style))
-	 (fill-pointer (fill-pointer string)))
-    (multiple-value-bind (width height) (bounding-rectangle-size record)
-      (declare (type coordinate width height))
-      (setf (fill-pointer string) (1+ fill-pointer)
-	    (aref string fill-pointer) character)
-      (incf width new-width)
-      (maxf height new-height)
-      (maxf (slot-value record 'baseline) new-baseline)
-      (bounding-rectangle-set-size record width height))))
-
-(defmethod prepare-text-record-for-appending
-    ((record standard-text-output-record) space-needed style)
-  (declare (fixnum space-needed))
-  (declare (ignore style))
-  (let* ((string (slot-value record 'string))
-	 (fill-pointer (fill-pointer string)))
-    (declare (fixnum fill-pointer))
-    (when (> (the fixnum (+ fill-pointer space-needed)) (array-dimension string 0))
-      (setf string (adjust-array string (the fixnum (+ fill-pointer space-needed 16))))
-      (setf (slot-value record 'string) string))
-    string))
-
-(defmethod prepare-text-record-for-appending
-    ((record styled-text-output-record) space-needed style)
-  (declare (fixnum space-needed))
-  (with-slots (initial-text-style current-text-style
-	       text-style-changes baseline) record
-    (let* ((string (slot-value record 'string))
-	   (fill-pointer (fill-pointer string)))
-      (unless (eql style current-text-style)
-	(if (null initial-text-style)
-	    (setf initial-text-style style)
-	    (let ((change-record (cons style fill-pointer)))
-	      (setf text-style-changes 
-		    (nconc text-style-changes (list change-record)))))
-	(setf current-text-style style))
-      (when (> (the fixnum (+ fill-pointer space-needed)) (array-dimension string 0))
-	(setf string (adjust-array string (the fixnum (+ fill-pointer space-needed 16))))
-	(setf (slot-value record 'string) string))
-      string)))
-
-(defun text-recompute-contents-id-test (id1 id2)
-  (or (eql id1 id2)
-      (and (stringp id2)
-	   (string= id1 id2))))
-
-;; We don't do a INVOKE-WITH-NEW-OUTPUT-RECORD for STANDARD-TEXT-OUTPUT-RECORDs.
-;; However, STREAM-CLOSE-TEXT-OUTPUT-RECORD does a RECOMPUTE-CONTENTS-OK, too.
-(defmethod recompute-contents-ok ((text standard-text-output-record))
-  (with-slots (string wrapped-p) text
-    (let* ((output-record (output-record-parent text))
-	   (match (and output-record
-		       (find-inferior-output-record
-			 output-record t 'standard-text-output-record
-			 :unique-id string :id-test #'text-recompute-contents-id-test))))
-      (when match
-	;; The old extent is a copy of MATCH's bounding rectangle
-	(setf (output-record-old-bounding-rectangle text) (bounding-rectangle match))
-	(when (and (bounding-rectangle-size-equal match text)
-		   (eql wrapped-p (slot-value match 'wrapped-p))
-		   (eql (class-of text) (class-of match)))
-	  (setf (output-record-contents-ok text) t)
-	  ;; make sure that old bounding-rect is the same relative position from
-	  ;; old-start-position as the bounding-rect is from start-position
-	  (multiple-value-bind (delta-x delta-y)
-	      (multiple-value-bind (ex ey) (bounding-rectangle-position* text)
-		(declare (type coordinate ex ey))
-		(multiple-value-bind (sx sy) 
-		    (output-record-start-cursor-position* text)
-		  (declare (type coordinate sx sy))
-		  (position-difference* ex ey sx sy)))
-	    (declare (type coordinate delta-x delta-y))
-	    (multiple-value-bind (old-start-x old-start-y)
-		(multiple-value-bind (px py) (bounding-rectangle-position* match)
-		  (declare (type coordinate px py))
-		  (position-difference* px py delta-x delta-y))
-	      (output-record-set-old-start-cursor-position*
-		text old-start-x old-start-y))))))))
-
-(defmethod recompute-contents-ok ((text styled-text-output-record))
-  (with-slots (string wrapped-p initial-text-style current-text-style text-style-changes)
-	      text
-    (let* ((output-record (output-record-parent text))
-	   (match (and output-record
-		       (find-inferior-output-record
-			 output-record t 'styled-text-output-record
-			 :unique-id string :id-test #'text-recompute-contents-id-test))))
-      (when match
-	;; The old extent is a copy of MATCH's bounding rectangle
-	(setf (output-record-old-bounding-rectangle text) (bounding-rectangle match))
-	;; --- maybe make a method out of this to get efficient slot access?
-	(when (and (bounding-rectangle-size-equal match text)
-		   (eql wrapped-p (slot-value match 'wrapped-p))
-		   (eql (class-of text) (class-of match))
-		   (eql initial-text-style
-			(slot-value match 'initial-text-style))
-		   (eql current-text-style
-			(slot-value match 'current-text-style))
-		   (equal text-style-changes
-			  (slot-value match 'text-style-changes)))
-	  (setf (output-record-contents-ok text) t)
-	  ;; make sure that old bounding-rect is the same relative position from
-	  ;; old-start-position as the bounding-rect is from start-position
-	  (multiple-value-bind (delta-x delta-y)
-	      (multiple-value-bind (ex ey) (bounding-rectangle-position* text)
-		(declare (type coordinate ex ey))
-		(multiple-value-bind (sx sy) 
-		    (output-record-start-cursor-position* text)
-		  (declare (type coordinate sx sy))
-		  (position-difference* ex ey sx sy)))
-	    (declare (type coordinate delta-x delta-y))
-	    (multiple-value-bind (old-start-x old-start-y)
-		(multiple-value-bind (px py) (bounding-rectangle-position* match)
-		  (declare (type coordinate px py))
-		  (position-difference* px py delta-x delta-y))
-	      (output-record-set-old-start-cursor-position*
-		text old-start-x old-start-y))))))))
-
-(defun find-text-baseline (record stream)
-  ;; This finds the lowest baseline of the text in RECORD, which will be slower than, say,
-  ;; the first baseline but more likely to look good with misaligned things.
-  (let ((baseline 0)
-	(style (medium-default-text-style stream)))
-    (declare (type coordinate baseline))
-    (labels ((find-or-recurse (record y-offset)
-	       (declare (type coordinate y-offset))
-	       (typecase record
-		 (styled-text-output-record
-		   (maxf baseline (+ y-offset (slot-value record 'baseline))))
-		 (standard-text-output-record
-		   (maxf baseline
-			 (+ y-offset (- (text-style-height style stream)
-					(text-style-descent style stream)))))
-		 (t
-		   (multiple-value-bind (xoff yoff) (output-record-position* record)
-		     (declare (type coordinate yoff))
-		     (declare (ignore xoff))
-		     (map-over-output-records #'find-or-recurse record
-					      0 0 (+ yoff y-offset)))))))
-      (declare (dynamic-extent #'find-or-recurse))
-      (find-or-recurse record 0))
-    baseline))
-
-
-;;; Mix this in for top-level output histories
-(defclass stream-output-history-mixin () ((stream)))
-
-(defmethod bounding-rectangle-set-edges ((record stream-output-history-mixin)
-					 left top right bottom)
-  (declare (type coordinate left top right bottom))
-  #+ignore (assert (<= left right))
-  #+ignore (assert (<= top bottom))
-  (with-slots ((bl left) (bt top) (br right) (bb bottom) parent stream) record
-    ;; Top-level output records must not have their upper left corner any
-    ;; "later" than (0,0), or else scroll bars and scrolling will not do
-    ;; the right thing.
-    (let ((old-left bl)
-	  (old-top bt)
-	  (old-right br)
-	  (old-bottom bb))
-      (declare (type coordinate old-left old-top old-right old-bottom))
-      (setq bl (min left 0)
-	    bt (min top 0)
-	    br right
-	    bb bottom)))
-  record)
-
-#+Silica
-(defmethod bounding-rectangle-set-edges :around ((r stream-output-history-mixin) 
-						 nminx nminy nmaxx nmaxy)
-  (multiple-value-bind
-      (minx miny maxx maxy)
-      (bounding-rectangle* r)
-    (call-next-method)
-    (unless (and (= minx nminx)
-		 (= miny nminy)
-		 (= maxx nmaxx)
-		 (= maxy nmaxy))
-      ;; This should update the scrollbars etc 
-      (let* ((stream (output-record-stream r))
-	     (vp (pane-viewport-sheet stream)))
-	(when vp
-	  (update-scrollbars vp))
-	(update-region stream (- nmaxx nminx) (- nmaxy nminy))))))
-
-;;; Defclass of OUTPUT-RECORDING-MIXIN, etc. is in STREAM-CLASS-DEFS
-(defmethod initialize-instance :after ((stream output-recording-mixin) &rest args)
-  (declare (ignore args))
-  (with-slots (output-record) stream
-    ;;--- Our OUTPUT-RECORDING-MIXIN expects extended output...
-    (multiple-value-bind (x y) (stream-cursor-position* stream)
-      ;; I don't understand why the output record's initial position was set to
-      ;; some untransformed "viewport" coordinate.  The cursor position is the
-      ;; right place, no?
-      (output-record-set-position* output-record x y))
-    (setf (slot-value output-record 'stream) stream)))
-
-(defmethod clear-output-history ((stream output-recording-mixin))
-  (when (stream-output-history stream)
-    (clear-output-record (stream-output-history stream)))
-  (setf (stream-text-output-record stream) nil)
-  (setf (stream-highlighted-presentation stream) nil))
-
-(defmethod stream-add-output-record ((stream output-recording-mixin) record)
-  (with-slots (output-record current-output-record-stack) stream
-    (let ((the-output-record (or current-output-record-stack output-record)))
-     (add-output-record record the-output-record)
-     #+Silica
-     (let ((width (bounding-rectangle-width stream))
-	   (height (bounding-rectangle-height stream)))
-       (declare (type coordinate width height))
-       (with-bounding-rectangle* (rl rt rr rb) the-output-record
-	 (when (or (< rl 0) (< width rr)
-		   (< rt 0) (< height rb))
-	   (update-region stream (- rr rl) (- rb rt))))))))
-
-(defmethod stream-replay ((stream output-recording-mixin) &optional region)
-  (when (stream-drawing-p stream)
-    (with-slots (output-record text-output-record record-p) stream
-      (when (or output-record text-output-record)
-	(letf-globally ((record-p nil))
-	  (when output-record
-	    (replay-output-record output-record stream region 0 0))
-	  (when text-output-record
-	    (replay-output-record text-output-record stream region 0 0)))))))
-
-(defun erase-output-record (output-record stream)	;--- specialize on stream?
-  (multiple-value-bind (xoff yoff)
-      (convert-from-relative-to-absolute-coordinates 
-	;; --- I'm certainly going to forget to use the PARENT at some point!
-	stream (output-record-parent output-record))
-    (with-bounding-rectangle* (left top right bottom) output-record
-      (with-output-recording-options (stream :record nil)
-	(if (or (= left right) (= top bottom))
-	    ;; Handle specially, for a line is wider than a rectangle of zero width or height
-	    (draw-line-internal stream xoff yoff
-				left top right bottom
-				+background-ink+ nil)
-	    (draw-rectangle-internal stream xoff yoff
-				     left top right bottom
-				     +background-ink+ nil)))))
-  (when (output-record-parent output-record)
-    (delete-output-record output-record (output-record-parent output-record)))
-  ;; Use the output record itself as the replay region, and replay
-  ;; the stuff that might have been obscured by the erased output
-  (frame-replay *application-frame* stream output-record))
-
-(defmethod invoke-with-output-recording-options ((stream output-recording-mixin)
-						 continuation record draw)
-  (letf-globally (((stream-recording-p stream) record)
-		  ((stream-drawing-p stream) draw))
-    (funcall continuation)))
-
-(defmethod get-text-output-record ((stream output-recording-mixin) style)
-  (let ((default-style (medium-default-text-style stream)))
-    (let ((record (stream-text-output-record stream)))
-      (when record
-	;; If we're changing styles mid-stream, need to convert this
-	;; text record to the more expensive form
-	(when (and (not (eq style default-style))
-		   (not (typep record 'styled-text-output-record)))
-	  (setq record (stylize-text-output-record record default-style stream)))
-	(return-from get-text-output-record record)))
-    (let* ((string (make-array 16 :element-type 'extended-char	;--- 16?
-				  :fill-pointer 0 :adjustable t))
-	   (record (if (not (eq style default-style))
-		       (make-styled-text-output-record (medium-ink stream) string)
-		       (make-standard-text-output-record (medium-ink stream) string))))
-      (setf (stream-text-output-record stream) record)
-      (multiple-value-bind (abs-x abs-y)
-	  (point-position*
-	    (stream-output-history-position stream))
-	(declare (type coordinate abs-x abs-y))
-	(multiple-value-bind (cx cy) (stream-cursor-position* stream)
-	  (declare (type coordinate cx cy))
-	  (output-record-set-start-cursor-position*
-	    record (- cx abs-x) (- cy abs-y))))
-      ;; Moved to STREAM-CLOSE-TEXT-OUTPUT-RECORD, since we don't need this thing
-      ;; in the history until then.  This should save an extra recompute-extent call
-      ;; (one in here, one when the string is added).
-      ;; (stream-add-output-record stream record)
-      record)))
-
-;; The cost of stylizing an existing record is actually fairly low, and we
-;; don't do it very often, because of the optimization in GET-TEXT-OUTPUT-RECORD
-;; that creates a stylized record as early as possible.
-(defmethod stylize-text-output-record ((record standard-text-output-record) style stream)
-  (with-slots (ink string wrapped-p left top right bottom
-	       start-x start-y end-x end-y) record
-    (let ((new-record (make-styled-text-output-record-1
-			ink string wrapped-p
-			style (- (text-style-height style stream)
-				 (text-style-descent style stream)))))
-      (with-slots ((new-left left) (new-top top) (new-right right) (new-bottom bottom)
-		   (new-sx start-x) (new-sy start-y) (new-ex end-x) (new-ey end-y)
-		   (new-wrapped-p wrapped-p)) new-record
-	(setq new-left left
-	      new-top top
-	      new-right right
-	      new-bottom bottom
-	      new-sx start-x
-	      new-sy start-y
-	      new-ex end-x
-	      new-ey end-y))
-      (setf (stream-text-output-record stream) new-record)
-      new-record)))
-
-;;; The following two are only called when STREAM-RECORDING-P is true and the
-;;; characters are printable (see CHARACTER-DRAWING.LISP).
-(defmethod stream-add-string-output ((stream output-recording-mixin) string
-				     start end text-style width height baseline)
-  (declare (fixnum start end))
-  (when (< start end)
-    (let ((record (get-text-output-record stream text-style)))
-      (add-string-output-to-text-record record string start end text-style
-					width height baseline))))
-
-(defmethod stream-add-character-output ((stream output-recording-mixin) character
-					text-style width height baseline)
-  (let ((record (get-text-output-record stream text-style)))
-    (add-character-output-to-text-record record character text-style
-					 width height baseline)))
-
-(defmethod stream-close-text-output-record ((stream output-recording-mixin)
-					    &optional wrapped)
-  ;; It's faster to access the slot directly instead of going through 
-  ;; STREAM-TEXT-OUTPUT-RECORD
-  (let ((text-record (slot-value stream 'text-output-record)))
-    (when text-record
-      (when wrapped
-	(setf (slot-value text-record 'wrapped-p) t))
-      (stream-add-output-record stream text-record)
-      (when (stream-redisplaying-p stream)
-	(recompute-contents-ok text-record))
-      (setf (slot-value stream 'text-output-record) nil))))
-
-(defmethod stream-force-output :after ((stream output-recording-mixin))
-  (stream-close-text-output-record stream))
-
-(defmethod stream-finish-output :after ((stream output-recording-mixin))
-  (stream-close-text-output-record stream))
-
-;; When setting cursor position, have to dump old text record.
-;; This is necessary in order to capture the correct cursor position in
-;; text output records.  If we did not close the current text record,
-;; a sequence such as WRITE-STRING/SET-CURSORPOS/WRITE-STRING would
-;; create only a single output record, and intervening whitespace would
-;; be lost if the two WRITE-STRINGs took place on the same line.
-(defmethod stream-set-cursor-position* :before ((stream output-recording-mixin) x y)
-  (declare (ignore x y))
-  (stream-close-text-output-record stream))
-
-;; This gets used to reposition the cursor when drawing text.  We need to
-;; close the text output record when there was a line wrap, but not when
-;; we are simply incrementing the cursor beyond the just-written glyph.
-(defmethod stream-set-cursor-position*-internal :before ((stream output-recording-mixin) x y)
-  (declare (ignore x))
-  (multiple-value-bind (old-x old-y) (stream-cursor-position* stream)
-    (declare (ignore old-x))
-    (unless (eql y old-y)
-      (stream-close-text-output-record stream))))
-
-;; Copy just the text from the window to the stream.  If REGION is supplied,
-;; only the text overlapping that region is copied.
-;; This loses information about text styles, presentations, and graphics, and
-;; doesn't deal perfectly with tab characters and changing baselines.
-(defun copy-textual-output-history (window stream &optional region)
-  (let* ((char-width (stream-character-width window #\space))
-	 (line-height (stream-line-height window))
-	 (history (stream-output-history window))
-	 (array (make-array (ceiling (bounding-rectangle-height history) line-height)
-			    :fill-pointer 0 :adjustable t :initial-element nil)))
-    (labels ((collect (record x-offset y-offset)
-	       (multiple-value-bind (start-x start-y)
-		   (output-record-start-cursor-position* record)
-		 (translate-positions x-offset y-offset start-x start-y)
-		 (when (typep record 'standard-text-output-record)
-		   (vector-push-extend (list* start-y start-x (slot-value record 'string))
-				       array))
-		 (map-over-output-records-overlapping-region
-		   #'collect record region 
-		   (- x-offset) (- y-offset) start-x start-y))))
-      (declare (dynamic-extent #'collect))
-      (collect history 0 0))
-    (sort array #'(lambda (r1 r2)
-		    (or (< (first r1) (first r2))
-			(and (= (first r1) (first r2))
-			     (< (second r1) (second r2))))))
-    (let ((current-x 0)
-	  (current-y (first (aref array 0))))
-      (dotimes (i (fill-pointer array))
-	(let* ((item (aref array i))
-	       (y (pop item))
-	       (x (pop item)))
-	  (unless (= y current-y)
-	    (dotimes (j (round (- y current-y) line-height))
-	      #-(or Allegro Minima) (declare (ignore j))
-	      (terpri stream)
-	      (setq current-x 0))
-	    (setq current-y y))
-	  (unless (= x current-x)
-	    (dotimes (j (round (- x current-x) char-width))
-	      #-(or Allegro Minima) (declare (ignore j))
-	      (write-char #\space stream))
-	    (setq current-x x))
-	  (write-string item stream)
-	  (incf current-x (stream-string-width window item)))))))
-
-;;; This method should cover a multitude of sins.
-#+Silica
-(defmethod repaint-sheet :after ((stream output-recording-mixin) region)
-  ;;--- Who should establish the clipping region?
-  ;; Who should clear the region?
-  (with-sheet-medium (medium stream)
-    (multiple-value-call #'draw-rectangle*
-      medium
-      (bounding-rectangle* (region-intersection
-			    region 
-			    (or (pane-viewport-region stream)
-				(bounding-rectangle stream))))
-      :ink +background-ink+))
-  (stream-replay stream region))
-
-
-
-;;; For Silica
-;;;--- Consider these old methods on a case-by-case basis to see if the
-;;; general handle-repaint method subsumes them.
-
-;;; --- should merge our process-update-region with handle-repaint
-;;; Do we use it anywhere where Silica isn't generating handle-repaint?
-
-;;; Mix in window-output-recording when you have mixed together
-;;; something supporting the window protocol and something supporting
-;;; the output recording protocol.
-#-Silica
-(progn
-
-(defmethod window-process-update-region :around ((stream window-output-recording))
-  (let ((update-region (slot-value stream 'update-region)))
-    (when update-region
-      (with-output-recording-options (stream :draw t :record nil)
-	(let ((highlighted-presentation (slot-value stream 'highlighted-presentation)))
-	  (when highlighted-presentation
-	    (highlight-output-record stream highlighted-presentation :unhighlight))
-	  (call-next-method)
-	  (dolist (region update-region)
-	    (with-clipping-region (stream region)
-	      (frame-replay *application-frame* stream region)))
-	  (when highlighted-presentation
-	    (highlight-output-record stream highlighted-presentation :highlight))))
-      (window-flush-update-region stream))))
-
-;;;--- We need some version of this code to do the area copying.
-(defmethod window-set-viewport-position* :around ((stream window-output-recording)
-						  new-x new-y)
-  (declare (ignore new-x new-y))
-  (with-bounding-rectangle* (left top right bottom) (window-viewport stream)
-    (call-next-method)
-    ;; now replay
-    (with-bounding-rectangle* (nl nt nr nb) (window-viewport stream)
-      (cond
-	;; if some of the stuff that was previously on display is still on display
-	;; bitblt it into the proper place and redraw the rest.
-	((ltrb-overlaps-ltrb-p left top right bottom
-			       nl nt nr nb)
-	 ;; move the old stuff to the new position
-	 (window-shift-visible-region stream left top right bottom
-				      nl nt nr nb)
-	 (window-process-update-region stream))
-	;; otherwise, just redraw the whole visible viewport
-	;; Adjust for the left and top margins by hand so clear-area doesn't erase
-	;; the margin components.
-	(t (multiple-value-bind (ml mt) (window-margins stream)
-	     ;;--- Will these be coords or fixnums?
-	     (declare (type coordinate ml mt))
-	     (multiple-value-bind (vw vh) (window-inside-size stream)
-	       (declare (type coordinate vw vh))
-	       (window-clear-area stream
-				  ml mt (+ ml vw) (+ mt vh))))
-	   (frame-replay *application-frame* stream (window-viewport stream)))))))
-
-(defmethod window-refresh :after ((stream window-output-recording))
-  ;; don't bother me, it takes too long and is useless since
-  ;; we'll refresh this again when it eventually becomes visible
-  (when (window-drawing-possible stream)
-    (frame-replay *application-frame* stream (window-viewport stream))
-    (let ((text-record (stream-text-output-record stream)))
-      (when text-record (replay text-record stream)))
-    (redisplay-decorations stream)))
-
-;;; I don't think that this is needed.
-(defmethod window-note-size-or-position-change :after ((stream window-output-recording)
-						       left top right bottom)
-  (declare (ignore left top right bottom))
-  #+Ignore
-  (when (window-visibility stream)
-    (window-refresh stream)))
-
-;;; --- Define Silica version of this.
-(defmethod window-clear :before ((stream window-output-recording))
-  (clear-output-history stream))
-
-) ; end of #-Silica PROGN
-
-
-;;; Genera compatibility
-
-#+Genera
-(defmethod stream-compatible-output-as-presentation
-	   ((stream output-recording-mixin)
-	    continuation xstream
-	    &key (object nil) (type t) single-box &allow-other-keys)
-  (dw:with-type-decoded (type-name nil pr-args) type
-    (if (or (null type)
-	    (and (eq type-name 'sys:expression)
-		 (not (getf pr-args :escape *print-escape*))
-		 (stringp object)))
-	(funcall continuation xstream)
-        (multiple-value-bind (object clim-type changed-p)
-	    (dw-type-to-clim-type object type)
-	  (if changed-p
-	      (with-output-as-presentation (xstream object clim-type
-					    :single-box single-box)
-		(funcall continuation xstream))
-	      (funcall continuation xstream))))))
-
-#+Genera
-(defmethod stream-compatible-output-as-presentation-1
-	   ((stream output-recording-mixin)
-	    continuation continuation-args
-	    &key (object nil) (type t) single-box &allow-other-keys)
-  (dw:with-type-decoded (type-name nil pr-args) type
-    (if (or (null type)
-	    (and (eq type-name 'sys:expression)
-		 (not (getf pr-args :escape *print-escape*))
-		 (stringp object)))
-	(apply continuation continuation-args)
-        (multiple-value-bind (object clim-type changed-p)
-	    (dw-type-to-clim-type object type)
-	  (if changed-p
-	      (with-output-as-presentation (stream object clim-type
-					    :single-box single-box)
-		(apply continuation continuation-args))
-	      (apply continuation continuation-args))))))
-
-
diff --git a/clim/present.lisp b/clim/present.lisp
index 200f6fae..d88a163d 100644
--- a/clim/present.lisp
+++ b/clim/present.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: present.lisp,v 1.2 92/01/31 14:58:31 cer Exp $
+;; $fiHeader: present.lisp,v 1.3 92/02/24 13:08:16 cer Exp $
 
 (in-package :clim-internals)
 
@@ -43,10 +43,10 @@
 				    :single-box single-box
 				    :allow-sensitive-inferiors allow-sensitive-inferiors
 				    :record-type record-type)
-	(call-presentation-generic-function present
+	(funcall-presentation-generic-function present
 	  object presentation-type stream view
 	  :acceptably acceptably :for-context-type for-context-type))
-      (call-presentation-generic-function present
+      (funcall-presentation-generic-function present
 	object presentation-type stream view
 	:acceptably acceptably :for-context-type for-context-type)))
 
diff --git a/clim/presentations.lisp b/clim/presentations.lisp
index 6581a137..180956c7 100644
--- a/clim/presentations.lisp
+++ b/clim/presentations.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: presentations.lisp,v 1.6 92/03/04 16:22:07 cer Exp $
+;; $fiHeader: presentations.lisp,v 1.7 92/03/10 10:12:45 cer Exp $
 
 (in-package :clim-internals)
 
@@ -92,7 +92,7 @@
 		   (if (eq record child)
 		       (call-next-method)	;avoid infinite recursion
 		       (highlight-output-record-1 child stream state)))
-		 (multiple-value-bind (xoff yoff) (output-record-position* child)
+		 (multiple-value-bind (xoff yoff) (output-record-position child)
 		   (declare (type coordinate xoff yoff))
 		   (map-over-output-records
 		     #'highlight child 0 0
@@ -187,14 +187,14 @@
       (when parent				;we're done if it's null
 	(multiple-value-bind (xoff yoff)
 	    (convert-from-relative-to-absolute-coordinates stream parent)
-	  (translate-fixnum-positions xoff yoff left top right bottom)))
+	  (translate-coordinates xoff yoff left top right bottom)))
       (loop
 	(cond ((or (null parent)
 		   (with-bounding-rectangle* (pleft ptop pright pbottom) parent
 		     (multiple-value-bind (xoff yoff)
 			 (convert-from-relative-to-absolute-coordinates 
 			   stream (output-record-parent parent))
-		       (translate-fixnum-positions xoff yoff pleft ptop pright pbottom))
+		       (translate-coordinates xoff yoff pleft ptop pright pbottom))
 		     (not (ltrb-equals-ltrb-p left top right bottom
 					      pleft ptop pright pbottom))))
 	       (return nil))
@@ -268,7 +268,7 @@
   (declare (type coordinate x y))
   ;; Depth first search for a presentation that is both under the pointer and
   ;; matches the input context.
-  ;; This relies on MAP-OVER-OUTPUT-RECORDS-CONTAINING-POINT* traversing
+  ;; This relies on MAP-OVER-OUTPUT-RECORDS-CONTAINING-POSITION traversing
   ;; the most recently drawn of overlapping output records first.
   (labels ((mapper (record presentations x-offset y-offset)
 	     (declare (type coordinate x-offset y-offset))
@@ -316,8 +316,8 @@
 		   (setq presentations more-presentations))
   
 		 ;; Depth-first recursion
-		 (multiple-value-bind (dx dy) (output-record-position* record)
-		   (map-over-output-records-containing-point* 
+		 (multiple-value-bind (dx dy) (output-record-position record)
+		   (map-over-output-records-containing-position 
 		     #'mapper record x y
 		     (- x-offset) (- y-offset)
 		     presentations (+ x-offset dx) (+ y-offset dy)))
@@ -363,7 +363,7 @@
     (when history-window
       (with-slots (highlighted-presentation) history-window
 	(multiple-value-bind (px py)
-	    (stream-pointer-position* history-window)
+	    (stream-pointer-position history-window)
 	  (let ((presentation (frame-find-innermost-applicable-presentation
 				frame input-context history-window px py)))
 	    (when (and (null presentation) 
diff --git a/clim/ptypes1.lisp b/clim/ptypes1.lisp
index 41d5fde8..8b9b5ad8 100644
--- a/clim/ptypes1.lisp
+++ b/clim/ptypes1.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: ptypes1.lisp,v 1.8 92/03/10 10:12:47 cer Exp Locker: cer $
+;; $fiHeader: ptypes1.lisp,v 1.9 92/04/10 14:27:06 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -1416,6 +1416,12 @@
 	,@(when options-var `(,options-var))
 	,@arguments))))
 
+(defmacro funcall-presentation-generic-function (presentation-function-name &body arguments)
+  `(call-presentation-generic-function ,presentation-function-name ,@arguments))
+
+(defmacro apply-presentation-generic-function (presentation-function-name &body arguments)
+  `(call-presentation-generic-function apply ,presentation-function-name ,@arguments))
+
 ;;; Presentation generic functions have their own class just so we can define
 ;;; one method that aids in implementing presentation-method-combination
 #-CCL-2
diff --git a/clim/ptypes2.lisp b/clim/ptypes2.lisp
index 8b49e554..6bd21330 100644
--- a/clim/ptypes2.lisp
+++ b/clim/ptypes2.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: ptypes2.lisp,v 1.4 92/02/24 13:08:24 cer Exp $
+;; $fiHeader: ptypes2.lisp,v 1.5 92/03/04 16:22:11 cer Exp $
 
 (in-package :clim-internals)
 
@@ -68,8 +68,8 @@
 		(handler-case
 		    (with-stack-list* (class-and-parameters class parameters-given)
 		      (with-stack-list* (type-specifier class-and-parameters options-given)
-			(call-presentation-generic-function presentation-type-specifier-p
-							    type-specifier)))
+			(funcall-presentation-generic-function
+			  presentation-type-specifier-p type-specifier)))
 		  (error () nil))
 	        ;; If no parameters nor options, no need for user-defined validation
 	        t)))))))
@@ -99,7 +99,7 @@
 	  (let ((description (getf options :description)))
 	    (if description
 		(default-describe-presentation-type description stream plural-count)
-		(call-presentation-generic-function describe-presentation-type
+		(funcall-presentation-generic-function describe-presentation-type
 		  type stream plural-count)))))))
 
 ;;; The default method that works for describing most presentation types
@@ -143,7 +143,8 @@
 (defun presentation-type-history (presentation-type)
   (let ((type (expand-presentation-type-abbreviation presentation-type)))
     (loop
-      (let ((history (call-presentation-generic-function presentation-type-history type)))
+      (let ((history 
+	      (funcall-presentation-generic-function presentation-type-history type)))
 	(cond ((null history)
 	       (return-from presentation-type-history nil))
 	      ((typep history 'basic-history)
@@ -169,7 +170,7 @@
 
 (defun presentation-default-preprocessor (default presentation-type &key default-type)
   (let ((type (expand-presentation-type-abbreviation presentation-type)))
-    (call-presentation-generic-function presentation-default-preprocessor
+    (funcall-presentation-generic-function presentation-default-preprocessor
       default type :default-type default-type)))
 
 (define-default-presentation-method presentation-default-preprocessor
@@ -186,7 +187,7 @@
 #+Genera (zwei:defindentation (map-over-presentation-type-supertypes 1 2))
 (defun map-over-presentation-type-supertypes (presentation-type function)
   (declare (dynamic-extent function))
-  (call-presentation-generic-function map-over-presentation-type-supertypes
+  (funcall-presentation-generic-function map-over-presentation-type-supertypes
     presentation-type function))
 
 ;;; Map over unparameterized presentation types, including some mappings
@@ -235,7 +236,7 @@
 	;; that object is a member of the correct class, or to do it all.
 	;; No default method should be defined, since what the default method
 	;; could do (call typep) has already been done above.
-	(call-presentation-generic-function presentation-typep object type)))))
+	(funcall-presentation-generic-function presentation-typep object type)))))
 
 
 ;;; SUBTYPEP
@@ -280,7 +281,7 @@
 		    (values t t))		;Everything is its own subtype
 		   (t
 		    (multiple-value-bind (subtype-p known-p)
-			(call-presentation-generic-function presentation-subtypep
+			(funcall-presentation-generic-function presentation-subtypep
 			  type putative-supertype)
 		      ;; Catch a common mistake in PRESENTATION-SUBTYPEP methods
 		      (when (and subtype-p (not known-p))
@@ -330,7 +331,8 @@
 				 (values t t))	;Everything is its own subtype
 				(t		;Call method to figure out the parameters
 				 (multiple-value-bind (subtype-p known-p)
-				     (call-presentation-generic-function presentation-subtypep
+				     (funcall-presentation-generic-function
+				       presentation-subtypep
 				       ntype putative-supertype)
 				   (when (and subtype-p (not known-p))
 				     (cerror "Return the two values T and T"
@@ -362,7 +364,7 @@
 ;;; Called when ACCEPT turns into PRESENT
 (defun accept-present-default (presentation-type stream view default default-supplied-p
 			       present-p query-identifier &key (prompt t))
-  (call-presentation-generic-function accept-present-default
+  (funcall-presentation-generic-function accept-present-default
     presentation-type stream view default default-supplied-p present-p query-identifier
     :prompt prompt))
 
@@ -383,7 +385,7 @@
 (defun highlight-presentation (record presentation-type stream state)
   (unless (eq record *null-presentation*)
     (with-output-recording-options (stream :record nil)
-      (call-presentation-generic-function highlight-presentation
+      (funcall-presentation-generic-function highlight-presentation
 	presentation-type record stream state)
       (force-output stream))))
 
diff --git a/clim/recording-defs.lisp b/clim/recording-defs.lisp
index e71e42cf..67bd1150 100644
--- a/clim/recording-defs.lisp
+++ b/clim/recording-defs.lisp
@@ -1,8 +1,8 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-(in-package :clim-internals)
+;; $fiHeader: recording-defs.lisp,v 1.2 92/03/10 15:46:27 cer Exp $
 
-;; $fiHeader$
+(in-package :clim-internals)
 
 "Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved."
 
diff --git a/clim/recording-protocol.lisp b/clim/recording-protocol.lisp
index b5741186..6adb3eff 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.6 92/03/24 19:37:56 cer Exp Locker: cer $
+;; $fiHeader: recording-protocol.lisp,v 1.7 92/04/14 15:29:55 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -38,7 +38,7 @@
 ;;;  map-over-output-records-overlapping-region:
 ;;;   (function record region
 ;;;    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
-;;;  map-over-output-records-containing-point*:
+;;;  map-over-output-records-containing-position:
 ;;;   (function record x y
 ;;;    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
 
@@ -47,9 +47,9 @@
 ;;;
 
 ;; Bounding rectangle position and set-position are in relative coordinates, 
-;;   relative to (OUTPUT-RECORD-POSITION* (OUTPUT-RECORD-PARENT RECORD)).
+;;   relative to (OUTPUT-RECORD-POSITION (OUTPUT-RECORD-PARENT RECORD)).
 ;; The bounding rectangle measures just the ink.
-;; (OUTPUT-RECORD-START-CURSOR-POSITION* RECORD) refers to the position of the
+;; (OUTPUT-RECORD-START-CURSOR-POSITION RECORD) refers to the position of the
 ;; cursor at the start of RECORD.  It is also the origin of the
 ;; coordinate system for all children of RECORD.
 (defclass output-record-element-mixin (standard-bounding-rectangle)
@@ -85,7 +85,7 @@
 
 ;;; Shadow the method on RECTANGLE with this one that keeps the start-position and 
 ;;; bounding rectangle in synch.
-(defmethod bounding-rectangle-set-position* ((record output-record-element-mixin) nx ny)
+(defmethod bounding-rectangle-set-position ((record output-record-element-mixin) nx ny)
   (declare (type coordinate nx ny))
   (with-slots (left top right bottom start-x start-y parent) record
     (declare (type coordinate left top right bottom start-x start-y))
@@ -99,7 +99,7 @@
 	    bottom (+ ny height)))))
 
 #+ignore
-(defmethod bounding-rectangle-set-position* :around ((record output-record-element-mixin) nx ny)
+(defmethod bounding-rectangle-set-position :around ((record output-record-element-mixin) nx ny)
   (with-bounding-rectangle* (x1 y1 x2 y2) record
     (call-next-method)
     (note-output-record-moved record (- nx x1) (- ny y1) (- nx x2) (- ny y2))))
@@ -116,25 +116,29 @@
   (declare (ignore dx1 dy1 dx2 dy2))
   nil)
 
-(defun-inline output-record-position* (record)
-  (output-record-start-cursor-position* record))
+(defun-inline output-record-position (record)
+  (output-record-start-cursor-position record))
 
-;; X and Y had better be fixnums
-;;--- Coerce to COORDINATE
-(defmethod output-record-set-position* ((record output-record-element-mixin) x y)
+(defmethod output-record-set-position ((record output-record-element-mixin) x y)
   (declare (type coordinate x y))
-  (bounding-rectangle-set-position* record x y))
+  (bounding-rectangle-set-position record (coordinate x) (coordinate y)))
 
-(defmethod output-record-start-cursor-position ((record output-record-element-mixin))
-  (with-slots (start-x start-y) record
-    (make-point start-x start-y)))
+#+CLIM-1-compatibility
+(define-compatibility-function (output-record-position* output-record-position)
+			       (record)
+  (output-record-position record))
+
+#+CLIM-1-compatibility
+(define-compatibility-function (output-record-set-position* output-record-set-position)
+			       (record x y)
+  (output-record-set-position record x y))
 
-(defmethod output-record-start-cursor-position* ((record output-record-element-mixin))
+(defmethod output-record-start-cursor-position ((record output-record-element-mixin))
   (with-slots (start-x start-y) record
     (values start-x start-y)))
 
 ;;; Keep the start-position and bounding rectangle in synch
-(defmethod output-record-set-start-cursor-position*
+(defmethod output-record-set-start-cursor-position
 	   ((record output-record-element-mixin) nx ny)
   (declare (type coordinate nx ny))
   (with-slots (start-x start-y) record
@@ -147,25 +151,21 @@
 	  (+ left dx) (+ top dy) (+ right dx) (+ bottom dy))
 	(setf start-x nx start-y ny)))))
 
-(defmethod output-record-end-cursor-position* ((record output-record-element-mixin))
+(defmethod output-record-end-cursor-position ((record output-record-element-mixin))
   (with-slots (end-x end-y) record
     (values end-x end-y)))
   
-(defmethod output-record-set-end-cursor-position* ((record output-record-element-mixin) nx ny)
+(defmethod output-record-set-end-cursor-position ((record output-record-element-mixin) nx ny)
   (declare (type coordinate nx ny))
   (with-slots (end-x end-y) record
     (setf end-x nx)
     (setf end-y ny)))
 
 (defmethod output-record-old-start-cursor-position ((record output-record-element-mixin))
-  (with-slots (old-start-x old-start-y) record
-    (make-point old-start-x old-start-y)))
-
-(defmethod output-record-old-start-cursor-position* ((record output-record-element-mixin))
   (with-slots (old-start-x old-start-y) record
     (values old-start-x old-start-y)))
 
-(defmethod output-record-set-old-start-cursor-position*
+(defmethod output-record-set-old-start-cursor-position
 	   ((record output-record-element-mixin) nx ny)
   (declare (type coordinate nx ny))
   (with-slots (old-start-x old-start-y) record
@@ -177,27 +177,29 @@
 (define-compatibility-function (output-record-start-position
 				output-record-start-cursor-position)
 			       (record)
-  (output-record-start-cursor-position record))
+  (multiple-value-bind (x y)
+      (output-record-start-cursor-position record)
+    (make-point x y)))
 
 (define-compatibility-function (output-record-start-position*
-				output-record-start-cursor-position*)
+				output-record-start-cursor-position)
 			       (record)
-  (output-record-start-cursor-position* record))
+  (output-record-start-cursor-position record))
 
 (define-compatibility-function (output-record-set-start-position*
-				output-record-set-start-cursor-position*)
+				output-record-set-start-cursor-position)
 			       (record nx ny)
-  (output-record-set-start-cursor-position* record nx ny))
+  (output-record-set-start-cursor-position record nx ny))
 
 (define-compatibility-function (output-record-end-position*
-				output-record-end-cursor-position*)
+				output-record-end-cursor-position)
 			       (record)
-  (output-record-end-cursor-position* record))
+  (output-record-end-cursor-position record))
 
 (define-compatibility-function (output-record-set-end-position*
-				output-record-set-end-cursor-position*)
+				output-record-set-end-cursor-position)
 			       (record nx ny)
-  (output-record-set-end-cursor-position* record nx ny))
+  (output-record-set-end-cursor-position record nx ny))
 )	;#+CLIM-1-compatibility
 
 
@@ -212,11 +214,11 @@
 (defun compute-output-record-offsets (record)
   (let ((parent (output-record-parent record)))
     (if (null parent)
-	(values 0 0)
+	(values (coordinate 0) (coordinate 0))
       (multiple-value-bind (x y)
 	  (compute-output-record-offsets parent)
 	(declare (type coordinate x y))
-	(multiple-value-bind (our-x our-y) (output-record-position* record)
+	(multiple-value-bind (our-x our-y) (output-record-position record)
 	  (declare (type coordinate our-x our-y))
 	  (values (+ our-x x) (+ our-y y)))))))
 
@@ -231,18 +233,18 @@
 	  (declare (type coordinate xoff1 yoff1))
 	  (multiple-value-bind (xoff2 yoff2) (compute-output-record-offsets record2)
 	    (declare (type coordinate xoff2 yoff2))
-	    (translate-fixnum-positions xoff1 yoff1 left1 top1 right1 bottom1)
-	    (translate-fixnum-positions xoff2 yoff2 left2 top2 right2 bottom2)
+	    (translate-coordinates xoff1 yoff1 left1 top1 right1 bottom1)
+	    (translate-coordinates xoff2 yoff2 left2 top2 right2 bottom2)
 	    (ltrb-equals-ltrb-p left1 top1 right1 bottom1
 				left2 top2 right2 bottom2)))))))
 
-(defmethod region-contains-point*-p
+(defmethod region-contains-position-p
 	   ((record output-record-element-mixin) x y)
   (with-bounding-rectangle* (left top right bottom) record
     (multiple-value-bind (xoff yoff) (compute-output-record-offsets record)
       (declare (type coordinate xoff yoff))
-      (ltrb-contains-point*-p left top right bottom
-			      (+ x xoff) (+ y yoff)))))
+      (ltrb-contains-position-p left top right bottom
+				(+ x xoff) (+ y yoff)))))
 
 (defmethod region-contains-region-p
 	   ((record1 output-record-element-mixin) (record2 output-record-element-mixin))
@@ -255,8 +257,8 @@
 	  (declare (type coordinate xoff1 yoff1))
 	  (multiple-value-bind (xoff2 yoff2) (compute-output-record-offsets record2)
 	    (declare (type coordinate xoff2 yoff2))
-	    (translate-fixnum-positions xoff1 yoff1 left1 top1 right1 bottom1)
-	    (translate-fixnum-positions xoff2 yoff2 left2 top2 right2 bottom2)
+	    (translate-coordinates xoff1 yoff1 left1 top1 right1 bottom1)
+	    (translate-coordinates xoff2 yoff2 left2 top2 right2 bottom2)
 	    (ltrb-contains-ltrb-p left1 top1 right1 bottom1
 				  left2 top2 right2 bottom2)))))))
 
@@ -271,8 +273,8 @@
 	  (declare (type coordinate xoff1 yoff1))
 	  (multiple-value-bind (xoff2 yoff2) (compute-output-record-offsets record2)
 	    (declare (type coordinate xoff2 yoff2))
-	    (translate-fixnum-positions xoff1 yoff1 left1 top1 right1 bottom1)
-	    (translate-fixnum-positions xoff2 yoff2 left2 top2 right2 bottom2)
+	    (translate-coordinates xoff1 yoff1 left1 top1 right1 bottom1)
+	    (translate-coordinates xoff2 yoff2 left2 top2 right2 bottom2)
 	    (ltrb-overlaps-ltrb-p left1 top1 right1 bottom1
 				  left2 top2 right2 bottom2)))))))
 
@@ -290,11 +292,11 @@
       (ltrb-overlaps-ltrb-p left1 top1 right1 bottom1
 			    (+ left2 xoff) (+ top2 yoff) (+ right2 xoff) (+ bottom2 yoff)))))
 
-(defun offset-region-contains-point*-p (region xoff yoff x y)
+(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-point*-p (+ left xoff) (+ top yoff) (+ right xoff) (+ bottom yoff)
-			     x y)))
+     (ltrb-contains-position-p (+ left xoff) (+ top yoff) (+ right xoff) (+ bottom yoff)
+			       x y)))
 
 ;;; This maps over all of the children of the record
 #+Genera (zwei:defindentation (map-over-output-records 1 1))
@@ -341,19 +343,19 @@
 ;;; This is because this function is used for things like locating the
 ;;; presentation under the pointer, where the topmost thing wants to be
 ;;; located first.
-#+Genera (zwei:defindentation (map-over-output-records-containing-point* 3 1))
-(defgeneric map-over-output-records-containing-point*
+#+Genera (zwei:defindentation (map-over-output-records-containing-position 3 1))
+(defgeneric map-over-output-records-containing-position
 	    (function record x y
 	     &optional x-offset y-offset &rest continuation-args)
   (declare (dynamic-extent function continuation-args)))
 
 #+CLIM-1-compatibility
 (define-compatibility-function (map-over-output-record-elements-containing-point*
-				map-over-output-records-containing-point*)
+				map-over-output-records-containing-position)
 			       (record x y function
 				&optional x-offset y-offset &rest continuation-args)
   (declare (dynamic-extent function continuation-args))
-  (apply #'map-over-output-records-containing-point*
+  (apply #'map-over-output-records-containing-position
 	 function record x y x-offset y-offset continuation-args))
 
 ;;; X-offset and Y-offset represent the accumulated offset between the
@@ -363,7 +365,7 @@
 ;;; 
 ;;; In the absence of x- and y- offsets, region should be in the
 ;;; coordinate system of the record - i.e. relative to 
-;;;  (OUTPUT-RECORD-POSITION* RECORD).
+;;;  (OUTPUT-RECORD-POSITION RECORD).
 ;;; This is the same coordinate system as the output record children
 ;;; we are mapping over.
 (defmethod map-over-output-records-overlapping-region
@@ -373,14 +375,14 @@
 	   (dynamic-extent function continuation-args))
   nil)
 
-(defmethod map-over-output-records-containing-point*
+(defmethod map-over-output-records-containing-position
 	   (function (record output-record-element-mixin) x y
 	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
   (declare (ignore x y function x-offset y-offset continuation-args)
 	   (dynamic-extent function continuation-args))
   nil)
 
-(defmethod map-over-output-records-containing-point*
+(defmethod map-over-output-records-containing-position
 	   (function (record t) x y
 	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
   (declare (dynamic-extent function continuation-args))
@@ -410,24 +412,28 @@
      record)))
 
 #+Silica
-(defmethod bounding-rectangle-set-position* :around ((record output-record-mixin) nx ny)
+(defmethod bounding-rectangle-set-position :around ((record output-record-mixin) nx ny)
   (multiple-value-bind (ox oy)
-      (output-record-position* record)
+      (output-record-position record)
     (call-next-method)
     (when (or (/= ox nx) (/= oy ny))
-      (note-output-record-moved record 1 1 1 1))))
+      (note-output-record-moved record 
+				(coordinate 1) (coordinate 1)
+				(coordinate 1) (coordinate 1)))))
 
 #+Silica
 (defmethod bounding-rectangle-set-edges :around ((record output-record-mixin) 
 						 left top right bottom)
   (declare (ignore  left top right bottom))
   (multiple-value-bind (ox oy)
-      (output-record-position* record)
+      (output-record-position record)
     (call-next-method)
     (multiple-value-bind (nx ny)
-	(output-record-position* record)
+	(output-record-position record)
       (when (or (/= ox nx) (/= oy ny))
-	(note-output-record-moved record 1 1 1 1)))))
+	(note-output-record-moved record 
+				  (coordinate 1) (coordinate 1)
+				  (coordinate 1) (coordinate 1))))))
 
 
 ;; If some coordinate is relative to a given output-record, then
@@ -437,19 +443,20 @@
 (defun convert-from-relative-to-absolute-coordinates (stream output-record)
   (declare (values x-offset y-offset))
   (cond ((null output-record)
-	 (values 0 0)) ;;---------------------------- Why?
+	 ;;--- Why on earth do we need this now?
+	 (values (coordinate 0) (coordinate 0)))
 	((and stream
 	      (eq output-record (stream-current-output-record stream)))
 	 (let ((position (stream-output-history-position stream)))
 	   (values (point-x position) (point-y position))))
 	((null (output-record-parent output-record))
-	 (values 0 0))
+	 (values (coordinate 0) (coordinate 0)))
 	(t
 	 (multiple-value-bind (x y)
 	     (convert-from-relative-to-absolute-coordinates
 	       stream (output-record-parent output-record))
 	   (declare (type coordinate x y))
-	   (multiple-value-bind (our-x our-y) (output-record-position* output-record)
+	   (multiple-value-bind (our-x our-y) (output-record-position output-record)
 	     (declare (type coordinate our-x our-y))
 	     (values (+ our-x x) (+ our-y y)))))))
 
@@ -463,13 +470,13 @@
 	 (let ((position (stream-output-history-position stream)))
 	   (values (- (point-x position)) (- (point-y position)))))
 	((null (output-record-parent output-record))
-	 (values 0 0))
+	 (values (coordinate 0) (coordinate 0)))
 	(t
 	 (multiple-value-bind (x y)
 	     (convert-from-absolute-to-relative-coordinates
 	       stream (output-record-parent output-record))
 	   (declare (type coordinate x y))
-	   (multiple-value-bind (our-x our-y) (output-record-position* output-record)
+	   (multiple-value-bind (our-x our-y) (output-record-position output-record)
 	     (declare (type coordinate our-x our-y))
 	     (values (- x our-x) (- y our-y)))))))
 
@@ -482,7 +489,7 @@
 (defun convert-from-ancestor-to-descendant-coordinates (ancestor descendant)
   (declare (values x-offset y-offset))
   (cond ((eq descendant ancestor)
-	 (values 0 0))
+	 (values (coordinate 0) (coordinate 0)))
 	((null descendant)
 	 (error "~S was not an ancestor of ~S" ancestor descendant))
 	(t
@@ -490,7 +497,7 @@
 	     (convert-from-ancestor-to-descendant-coordinates
 	       ancestor (output-record-parent descendant))
 	   (declare (type coordinate x y))
-	   (multiple-value-bind (our-x our-y) (output-record-position* descendant)
+	   (multiple-value-bind (our-x our-y) (output-record-position descendant)
 	     (declare (type coordinate our-x our-y))
 	     (values (- x our-x) (- y our-y)))))))
 
@@ -503,15 +510,15 @@
 (defun convert-from-descendant-to-ancestor-coordinates (descendant ancestor)
   (declare (values x-offset y-offset))
   (cond ((eq descendant ancestor)
-	 (values 0 0))
+	 (values (coordinate 0) (coordinate 0)))
 	((null descendant)
-	 (error "~s was not an ancestor of ~s" ancestor descendant))
+	 (error "~S was not an ancestor of ~S" ancestor descendant))
 	(t
 	 (multiple-value-bind (x y)
 	     (convert-from-descendant-to-ancestor-coordinates
 	       (output-record-parent descendant) ancestor)
 	   (declare (type coordinate x y))
-	   (multiple-value-bind (our-x our-y) (output-record-position* descendant)
+	   (multiple-value-bind (our-x our-y) (output-record-position descendant)
 	     (declare (type coordinate our-x our-y))
 	     (values (+ our-x x) (+ our-y y)))))))
 
@@ -523,15 +530,15 @@
 	  (stream-output-history-position stream)))
     (unless abs-y
       (multiple-value-setq (abs-x abs-y)
-	(stream-cursor-position* stream)))
+	(stream-cursor-position stream)))
     (letf-globally (((point-x current-output-position) abs-x)
 		    ((point-y current-output-position) abs-y)
 		    ((stream-current-output-record stream) record))
       (funcall continuation record)
       (multiple-value-bind (end-x end-y)
-	  (stream-cursor-position* stream)
+	  (stream-cursor-position stream)
 	(declare (type coordinate end-x end-y))
-	(output-record-set-end-cursor-position*
+	(output-record-set-end-cursor-position
 	  record (- end-x abs-x) (- end-y abs-y)))
       (stream-close-text-output-record stream))))
 
@@ -582,14 +589,14 @@
 				   (apply #'find-inferior-output-record-1
 					  current-output-record record-type init-args))))
       (multiple-value-bind (cursor-x cursor-y)
-	  (stream-cursor-position* stream)
+	  (stream-cursor-position stream)
 	(declare (type coordinate cursor-x cursor-y))
 	(multiple-value-bind (x y)
 	    (multiple-value-bind (px py)
-		(point-position*
+		(point-position
 		  (stream-output-history-position stream))
 	      (declare (type coordinate px py))
-	      (position-difference* cursor-x cursor-y px py))
+	      (position-difference cursor-x cursor-y px py))
 	  (declare (type coordinate x y))
 	  (if new-output-record
 	      (copy-display-state new-output-record nil)
@@ -601,7 +608,7 @@
 			       :x-position x :y-position y init-args)
 			(apply #'construct-output-record-1 record-type
 			       :x-position x :y-position y init-args))))
-	  (output-record-set-start-cursor-position* new-output-record x y)
+	  (output-record-set-start-cursor-position new-output-record x y)
 	  (with-output-record-1 continuation 
 				stream new-output-record cursor-x cursor-y)
 	  (when (stream-redisplaying-p stream)
@@ -622,14 +629,14 @@
 	    (with-first-quadrant-coordinates (stream)
 	      (with-new-output-record (stream record-type)
 		(funcall continuation stream))))))
-    (multiple-value-bind (x y) (output-record-position* record)
+    (multiple-value-bind (x y) (output-record-position record)
       (declare (type coordinate x y))
       ;;--- Hey, there is something wierd going on here.  The problem is that
-      ;;--- OUTPUT-RECORD-POSITION* and OUTPUT-RECORD-SET-POSITION* seem to obey
+      ;;--- OUTPUT-RECORD-POSITION and OUTPUT-RECORD-SET-POSITION seem to obey
       ;;--- different coordinate system conventions.  Geez.
       (when height
 	(incf y (- height (bounding-rectangle-height record))))
-      (output-record-set-position* record x y))
+      (output-record-set-position record x y))
     (tree-recompute-extent record)
     (replay record stream)
     (when move-cursor
@@ -654,7 +661,7 @@
   (labels ((replay-1 (record x-offset y-offset)
 	     (declare (type coordinate x-offset y-offset))
 	     (if (output-record-p record)
-		 (multiple-value-bind (xoff yoff) (output-record-position* record)
+		 (multiple-value-bind (xoff yoff) (output-record-position record)
 		   (map-over-output-records-overlapping-region 
 		     #'replay-1 record region 
 		     (- x-offset) (- y-offset)
@@ -671,7 +678,7 @@
     (with-bounding-rectangle* (left top right bottom) record
       (declare (ignore left top))
       (with-end-of-page-action (stream :allow)
-	(stream-set-cursor-position*
+	(stream-set-cursor-position
 	  stream
 	  (+ right x-offset) (- (+ bottom y-offset) (stream-line-height stream)))))))
 
@@ -700,7 +707,10 @@
   (with-slots (parent) record
     (with-bounding-rectangle* (old-left old-top old-right old-bottom) record
       (let ((once nil)
-	    (min-x 0) (min-y 0) (max-x 0) (max-y 0))
+	    (min-x (coordinate 0))
+	    (min-y (coordinate 0))
+	    (max-x (coordinate 0))
+	    (max-y (coordinate 0)))
 	(declare (type coordinate min-x min-y max-x max-y))
 	(flet ((recompute-extent-of-child (child)
 		 (with-bounding-rectangle* (left top right bottom) child
@@ -727,9 +737,11 @@
 		       (+ min-x xoff) (+ min-y yoff)
 		       (+ max-x xoff) (+ max-y yoff)))
 	      ;; No children
-	      (bounding-rectangle-set-edges record 0 0 0 0))
+	      (bounding-rectangle-set-edges record
+					    (coordinate 0) (coordinate 0)
+					    (coordinate 0) (coordinate 0)))
 	  ;; Pass these coordinates in parent's coordinate system (I think)
-	  (translate-fixnum-positions xoff yoff
+	  (translate-coordinates xoff yoff
 	    old-left old-top old-right old-bottom))
 	(when parent
 	  (recompute-extent-for-changed-child
@@ -745,7 +757,7 @@
 	(with-bounding-rectangle* (eleft etop eright ebottom) child
 	  (multiple-value-bind (xoff yoff)
 	      (convert-from-descendant-to-ancestor-coordinates record parent)
-	    (translate-fixnum-positions xoff yoff
+	    (translate-coordinates xoff yoff
 	      eleft etop eright ebottom
 	      ;; pass these coordinates in parent's coordinate system.
 	      old-left old-top old-right old-bottom))
@@ -767,7 +779,7 @@
 	(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-fixnum-positions xoff yoff old-left old-top old-right old-bottom))
+	(translate-coordinates xoff yoff old-left old-top old-right old-bottom))
       (tree-recompute-extent-1 record)
       (when parent
 	(recompute-extent-for-changed-child
@@ -819,7 +831,7 @@
     (multiple-value-bind (xoff yoff)
 	(convert-from-descendant-to-ancestor-coordinates child record)
       (declare (type coordinate xoff yoff))
-      (translate-fixnum-positions xoff yoff left top right bottom)
+      (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.
 
@@ -852,7 +864,9 @@
   (map-over-output-records #'free-output-record record))
 
 (defmethod clear-output-record :after ((record output-record-mixin))
-  (bounding-rectangle-set-edges record 0 0 0 0))
+  (bounding-rectangle-set-edges record 
+				(coordinate 0) (coordinate 0)
+				(coordinate 0) (coordinate 0)))
 
 (defmethod clear-output-record :around ((record output-record-mixin))
   (when (output-record-stream record)
@@ -950,7 +964,8 @@
 		     ;; Shift the whole vector downward
 		     (do ((i (the fixnum index) (1+ i)))
 			 ((= i new-fp))
-		       (declare (fixnum i) (optimize (speed 3) (safety 0)))
+		       (declare (type fixnum i)
+				(optimize (speed 3) (safety 0)))
 		       (setf (svref vector i) (svref vector (1+ i)))))
 		   (setf fill-pointer new-fp)))
 		(errorp
@@ -976,11 +991,11 @@
 	    (dovector (child elements :start 0 :end fill-pointer :simple-p t)
 	      (apply function child continuation-args))
 	  (with-bounding-rectangle* (left1 top1 right1 bottom1) region
-	    (translate-fixnum-positions x-offset y-offset left1 top1 right1 bottom1)
+	    (translate-coordinates x-offset y-offset left1 top1 right1 bottom1)
 	    ;; Subtract out the record offset from the region, to make comparison fair
 	    (multiple-value-bind (xoff yoff)
-		(output-record-position* record)
-	      (translate-fixnum-positions (- xoff) (- yoff) left1 top1 right1 bottom1))
+		(output-record-position record)
+	      (translate-coordinates (- xoff) (- yoff) left1 top1 right1 bottom1))
 	    (dovector (child elements :start 0 :end fill-pointer :simple-p t)
 	      (with-bounding-rectangle* (left2 top2 right2 bottom2) child
 		(when (ltrb-overlaps-ltrb-p left1 top1 right1 bottom1
@@ -990,34 +1005,34 @@
 	(if (or (null region) (eq region +everywhere+))
 	    (apply function elements continuation-args)
 	  (multiple-value-bind (xoff yoff)
-	      (output-record-position* record)
+	      (output-record-position record)
 	    (declare (type coordinate xoff yoff))
 	    (when (region-intersects-offset-region-p
 		    elements region (- x-offset xoff) (- y-offset yoff))
 	      (apply function elements continuation-args)))))))
   nil)
 
-(defmethod map-over-output-records-containing-point*
+(defmethod map-over-output-records-containing-position
 	   (function (record standard-sequence-output-record) x y 
 	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
   (declare (dynamic-extent function continuation-args))
   (declare (type coordinate x y x-offset y-offset))
   (declare (optimize (safety 0)))
-  (translate-fixnum-positions x-offset y-offset x y)
+  (translate-coordinates x-offset y-offset x y)
   (with-slots (elements fill-pointer) record
     (typecase elements
       (null nil)
       (array
 	(multiple-value-bind (xoff yoff)
-	    (output-record-position* record)
-	  (translate-fixnum-positions (- xoff) (- yoff) x y))
+	    (output-record-position record)
+	  (translate-coordinates (- xoff) (- yoff) x y))
 	(dovector (child elements :start 0 :end fill-pointer :from-end t :simple-p t)
 	  (with-bounding-rectangle* (left top right bottom) child
-	    (when (ltrb-contains-point*-p left top right bottom x y)
+	    (when (ltrb-contains-position-p left top right bottom x y)
 	      (apply function child continuation-args)))))
       (otherwise
-	(multiple-value-bind (xoff yoff) (output-record-position* record)
-	  (when (offset-region-contains-point*-p elements xoff yoff x y)
+	(multiple-value-bind (xoff yoff) (output-record-position record)
+	  (when (offset-region-contains-position-p elements xoff yoff x y)
 	    (apply function elements continuation-args))))))
   nil)
 
@@ -1026,61 +1041,53 @@
 (defclass stream-output-history-mixin () ((stream)))
 
 (defmethod bounding-rectangle-set-edges ((record stream-output-history-mixin)
-					 left top right bottom)
-  (declare (type coordinate left top right bottom))
-  #+ignore (assert (<= left right))
-  #+ignore (assert (<= top bottom))
-  (with-slots ((bl left) (bt top) (br right) (bb bottom) parent stream) record
+					 nleft ntop nright nbottom)
+  (declare (type coordinate nleft ntop nright nbottom))
+  #+ignore (assert (<= nleft nright))
+  #+ignore (assert (<= ntop  nbottom))
+  (with-slots (left top right bottom parent stream) record
     ;; Top-level output records must not have their upper left corner any
     ;; "later" than (0,0), or else scroll bars and scrolling will not do
     ;; the right thing.
-    (let ((old-left bl)
-	  (old-top bt)
-	  (old-right br)
-	  (old-bottom bb))
+    (let ((old-left left)
+	  (old-top  top)
+	  (old-right  right)
+	  (old-bottom bottom))
       (declare (type coordinate old-left old-top old-right old-bottom))
-      (setq bl (min left 0)
-	    bt (min top 0)
-	    br right
-	    bb bottom)))
+      (setq left (min nleft (coordinate 0))
+	    top  (min ntop  (coordinate 0))
+	    right  nright
+	    bottom nbottom)))
   record)
 
 #+Silica
-(defmethod bounding-rectangle-set-edges :around ((r stream-output-history-mixin) 
-						 nminx nminy nmaxx nmaxy)
-  (multiple-value-bind
-      (minx miny maxx maxy)
-      (bounding-rectangle* r)
+(defmethod bounding-rectangle-set-edges :around ((record stream-output-history-mixin) 
+						 nleft ntop nright nbottom)
+  (with-bounding-rectangle* (left top right bottom) record
     (call-next-method)
-    (unless (and (= minx nminx)
-		 (= miny nminy)
-		 (= maxx nmaxx)
-		 (= maxy nmaxy))
-      ;; This should update the scrollbars etc 
-      (let* ((stream (output-record-stream r))
-	     (vp (pane-viewport stream)))
-	(when vp
-	  (update-scrollbars vp))
-	#-ignore
-	(update-region stream 
-		       nminx
-		       nminy
-		       nmaxy
-		       nmaxx)
-	#+ignore
-	(update-region stream (- nmaxx nminx) (- nmaxy nminy))))))
+    (unless (and (= left nleft)
+		 (= top  ntop)
+		 (= right  nright)
+		 (= bottom nbottom))
+      ;; This should update the scroll-bars etc 
+      (let* ((stream (output-record-stream record))
+	     (viewport (pane-viewport stream)))
+	(when viewport
+	  (update-scroll-bars viewport))
+	(update-region stream nleft ntop nright nbottom)))))
 
 ;;; Defclass of OUTPUT-RECORDING-MIXIN, etc. is in STREAM-CLASS-DEFS
 (defmethod initialize-instance :after ((stream output-recording-mixin) &rest args)
   (declare (ignore args))
   (with-slots (output-record) stream
     ;;--- Our OUTPUT-RECORDING-MIXIN expects extended output...
-    (multiple-value-bind (x y) (stream-cursor-position* stream)
+    (multiple-value-bind (x y) (stream-cursor-position stream)
       ;; I don't understand why the output record's initial position was set to
       ;; some untransformed "viewport" coordinate.  The cursor position is the
       ;; right place, no?
-      (output-record-set-position* output-record x y))
-    (setf (slot-value output-record 'stream) stream)))
+      (output-record-set-position output-record x y))
+    (when (typep output-record 'stream-output-history-mixin)
+      (setf (slot-value output-record 'stream) stream))))
 
 (defmethod clear-output-history ((stream output-recording-mixin))
   (when (stream-output-history stream)
@@ -1091,16 +1098,15 @@
 (defmethod stream-add-output-record ((stream output-recording-mixin) record)
   (with-slots (output-record current-output-record-stack) stream
     (let ((the-output-record (or current-output-record-stack output-record)))
-      (add-output-record record the-output-record)
-      ;;--- I think we let the history worry about this
-      #+ignore-Silica
-      (let ((width (bounding-rectangle-width stream))
-	    (height (bounding-rectangle-height stream)))
-	(declare (type coordinate width height))
-	(with-bounding-rectangle* (rl rt rr rb) the-output-record
-				  (when (or (< rl 0) (< width rr)
-					    (< rt 0) (< height rb))
-				    (update-region stream (- rr rl) (- rb rt))))))))
+     (add-output-record record the-output-record)
+     #+++ignore		;--- the output history already does this, we think
+     (let ((width (bounding-rectangle-width stream))
+	   (height (bounding-rectangle-height stream)))
+       (declare (type coordinate width height))
+       (with-bounding-rectangle* (rl rt rr rb) the-output-record
+	 (when (or (< rl 0) (< width rr)
+		   (< rt 0) (< height rb))
+	   (update-region stream rl rt rr rb)))))))
 
 (defmethod stream-replay ((stream output-recording-mixin) &optional region)
   (when (stream-drawing-p stream)
@@ -1139,12 +1145,11 @@
 		  ((stream-drawing-p stream) draw))
     (funcall continuation)))
 
-
 ;;; The following two are only called when STREAM-RECORDING-P is true and the
 ;;; characters are printable (see CHARACTER-DRAWING.LISP).
 (defmethod stream-add-string-output ((stream output-recording-mixin) string
 				     start end text-style width height baseline)
-  (declare (fixnum start end))
+  (declare (type fixnum start end))
   (when (< start end)
     (let ((record (get-text-output-record stream text-style)))
       (add-string-output-to-text-record record string start end text-style
@@ -1181,16 +1186,16 @@
 ;; a sequence such as WRITE-STRING/SET-CURSORPOS/WRITE-STRING would
 ;; create only a single output record, and intervening whitespace would
 ;; be lost if the two WRITE-STRINGs took place on the same line.
-(defmethod stream-set-cursor-position* :before ((stream output-recording-mixin) x y)
+(defmethod stream-set-cursor-position :before ((stream output-recording-mixin) x y)
   (declare (ignore x y))
   (stream-close-text-output-record stream))
 
 ;; This gets used to reposition the cursor when drawing text.  We need to
 ;; close the text output record when there was a line wrap, but not when
 ;; we are simply incrementing the cursor beyond the just-written glyph.
-(defmethod stream-set-cursor-position*-internal :before ((stream output-recording-mixin) x y)
+(defmethod stream-set-cursor-position-internal :before ((stream output-recording-mixin) x y)
   (declare (ignore x))
-  (multiple-value-bind (old-x old-y) (stream-cursor-position* stream)
+  (multiple-value-bind (old-x old-y) (stream-cursor-position stream)
     (declare (ignore old-x))
     (unless (eq y old-y)
       (stream-close-text-output-record stream))))
@@ -1243,7 +1248,7 @@
       (window-flush-update-region stream))))
 
 ;;;--- We need some version of this code to do the area copying.
-(defmethod window-set-viewport-position* :around ((stream window-output-recording)
+(defmethod window-set-viewport-position :around ((stream window-output-recording)
 						  new-x new-y)
   (declare (ignore new-x new-y))
   (with-bounding-rectangle* (left top right bottom) (window-viewport stream)
@@ -1263,7 +1268,6 @@
 	;; Adjust for the left and top margins by hand so clear-area doesn't erase
 	;; the margin components.
 	(t (multiple-value-bind (ml mt) (window-margins stream)
-	     ;;--- Will these be coords or fixnums?
 	     (declare (type coordinate ml mt))
 	     (multiple-value-bind (vw vh) (window-inside-size stream)
 	       (declare (type coordinate vw vh))
diff --git a/clim/standard-tree.lisp b/clim/standard-tree.lisp
index be52bdc0..cf6b84e7 100644
--- a/clim/standard-tree.lisp
+++ b/clim/standard-tree.lisp
@@ -19,7 +19,7 @@
 ;; applicable.
 ;;
 
-;; $fiHeader: standard-tree.lisp,v 1.1 91/11/25 10:00:54 cer Exp Locker: cer $
+;; $fiHeader: standard-tree.lisp,v 1.2 92/03/09 17:41:53 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -235,11 +235,11 @@ Copyright (c) 1991, Franz Inc. All rights reserved
 ;		 (= miny nminy)
 ;		 (= maxx nmaxx)
 ;		 (= maxy nmaxy))
-;      ;; This should update the scrollbars etc 
+;      ;; This should update the scroll-bars etc 
 ;      (let* ((stream (stream-output-history-mixin-stream r))
 ;	     (vp (pane-viewport-sheet stream)))
 ;	(when vp
-;	  (update-scrollbars vp))
+;	  (update-scroll-bars vp))
 ;	(update-region stream 
 ;		       nminx
 ;		       nminy
diff --git a/clim/standard-types.lisp b/clim/standard-types.lisp
index 034cb738..65a42ce7 100644
--- a/clim/standard-types.lisp
+++ b/clim/standard-types.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: standard-types.lisp,v 1.4 92/03/04 16:22:15 cer Exp $
+;; $fiHeader: standard-types.lisp,v 1.5 92/03/10 10:12:52 cer Exp $
 
 (in-package :clim-internals)
 
@@ -407,10 +407,13 @@
 				   (pathname-complete string action default))
 			:allow-any-input t :help-displays-possibilities nil)
       (declare (ignore success))
-      (unless pathname
-	(setq pathname (parse-namestring string nil default)))
-      (when merge-default
-	(setq pathname (merge-pathnames pathname default default-version)))
+      (handler-bind ((error
+		       #'(lambda (error)
+			   (simple-parse-error "Error parsing pathname string ~A" string))))
+        (unless pathname
+	  (setq pathname (parse-namestring string nil default)))
+	(when merge-default
+	  (setq pathname (merge-pathnames pathname default default-version))))
       (unless (rescanning-p stream)
 	(presentation-replace-input stream pathname type view
 				    :buffer-start buffer-start))
@@ -497,7 +500,8 @@
 
 ;;;; "One-of" Presentation Types
 
-(define-presentation-type completion (sequence &key (test 'eql) (value-key 'identity))
+(define-presentation-type completion (&optional (sequence nil)
+				      &key (test 'eql) (value-key 'identity))
   :options ((name-key 'completion-default-name-key)
 	    (documentation-key 'completion-default-doc-key)
 	    (partial-completers '(#\Space))))
@@ -655,8 +659,8 @@
 
 ;;;; "Some-of" Presentation Types
 
-(define-presentation-type subset-completion
-			  (sequence &key (test 'eql) (value-key 'identity))
+(define-presentation-type subset-completion (&optional (sequence nil)
+					     &key (test 'eql) (value-key 'identity))
   :options ((name-key 'completion-default-name-key)
 	    (documentation-key 'completion-default-doc-key)
 	    (partial-completers '(#\Space))
@@ -980,13 +984,13 @@
 	       (if default-supplied-p
 		   (if history
 		       (with-default-bound-in-history history default-element
-			 (call-presentation-generic-function accept
+			 (funcall-presentation-generic-function accept
 			   element-type stream view
 			   :default element-default :default-type element-default-type))
-		       (call-presentation-generic-function accept
+		       (funcall-presentation-generic-function accept
 			 element-type stream view
 			 :default element-default :default-type element-default-type))
-		   (call-presentation-generic-function accept
+		   (funcall-presentation-generic-function accept
 		     element-type stream view))))
 	 ;; The user clicked on an object having the element type
 	 (t
@@ -1151,7 +1155,7 @@
     (when (presentation-typep object type)
       (return-from present
 	;; This must call the real present function, rather than using
-	;; call-presentation-generic-function, so that a nested presentation
+	;; CALL-PRESENTATION-GENERIC-FUNCTION, so that a nested presentation
 	;; of the correct type will be created
 	;;--- Maybe.  See RWK comment in the DW version.
 	(apply #'present object type :stream stream :view view options))))
@@ -1192,13 +1196,13 @@
 		       (presentation-typep default type))
 		  (if history
 		      (with-default-bound-in-history history default-element
-			(call-presentation-generic-function accept
+			(funcall-presentation-generic-function accept
 			  type stream view
 			  :default default :default-type default-type))
-		      (call-presentation-generic-function accept
+		      (funcall-presentation-generic-function accept
 			type stream view
 			:default default :default-type default-type))
-		  (call-presentation-generic-function accept
+		  (funcall-presentation-generic-function accept
 		    type stream view))
 	    (return-from accept
 	      (values object (or object-type type)))))))
@@ -1281,14 +1285,14 @@
 
 (define-presentation-method present (object (type and) stream view &rest options)
   (declare (dynamic-extent options))
-  (call-presentation-generic-function apply present
+  (apply-presentation-generic-function present
     object (first types) stream view options))
 
 (define-presentation-method accept ((type and) stream view &rest options)
   (declare (dynamic-extent options))
   (loop
     (multiple-value-bind (object input-type)
-	(call-presentation-generic-function apply accept
+	(apply-presentation-generic-function accept
 	  (first types) stream view options)
       (when (every #'(lambda (type) (and-presentation-typep object type)) (rest types))
 	(return-from accept (values object input-type)))
@@ -1313,12 +1317,12 @@
 (define-presentation-method accept ((type boolean) stream view &rest options)
   (declare (dynamic-extent options))
   (values
-    (call-presentation-generic-function apply accept
+    (apply-presentation-generic-function accept
       *boolean-member-type* stream view options)))
 
 (define-presentation-method present (object (type boolean) stream view &rest options)
   (declare (dynamic-extent options))
-  (call-presentation-generic-function apply present
+  (apply-presentation-generic-function present
     object *boolean-member-type* stream view options))
 
 ;; Supplying this gives us a nice "pushbutton" effect for booleans, too
diff --git a/clim/stream-class-defs.lisp b/clim/stream-class-defs.lisp
index 65d0924c..b56c8918 100644
--- a/clim/stream-class-defs.lisp
+++ b/clim/stream-class-defs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: stream-class-defs.lisp,v 1.3 92/01/31 14:58:45 cer Exp $
+;; $fiHeader: stream-class-defs.lisp,v 1.4 92/02/24 13:08:30 cer Exp $
 
 (in-package :clim-internals)
 
@@ -17,8 +17,8 @@
 					 left top right bottom)
   (bounding-rectangle-set-edges (slot-value stream 'stream) left top right bottom))
 
-(defmethod bounding-rectangle-set-position* ((stream standard-encapsulating-stream) x y)
-  (bounding-rectangle-set-position* (slot-value stream 'stream) x y))
+(defmethod bounding-rectangle-set-position ((stream standard-encapsulating-stream) x y)
+  (bounding-rectangle-set-position (slot-value stream 'stream) x y))
 
 (defmethod bounding-rectangle-set-size ((stream standard-encapsulating-stream) width height)
   (bounding-rectangle-set-size (slot-value stream 'stream) width height))
diff --git a/clim/stream-defprotocols.lisp b/clim/stream-defprotocols.lisp
index e9ab0f8c..dc8d48b7 100644
--- a/clim/stream-defprotocols.lisp
+++ b/clim/stream-defprotocols.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: stream-defprotocols.lisp,v 1.4 92/02/24 13:08:31 cer Exp $
+;; $fiHeader: stream-defprotocols.lisp,v 1.5 92/03/04 16:22:17 cer Exp $
 
 (in-package :clim-internals)
 
@@ -107,11 +107,11 @@
 (defoperation stream-input-wait basic-extended-input-protocol 
   ((stream basic-extended-input-protocol) &key timeout input-wait-test))
 
-(defoperation stream-pointer-position* basic-extended-input-protocol
+(defoperation stream-pointer-position basic-extended-input-protocol
   ((stream basic-extended-input-protocol) &key (timeout 0) pointer)
   (declare (values x y)))
 
-(defoperation stream-set-pointer-position* basic-extended-input-protocol
+(defoperation stream-set-pointer-position basic-extended-input-protocol
   ((stream basic-extended-input-protocol) x y &key pointer))
 
 (defoperation stream-note-pointer-button-press basic-extended-input-protocol
@@ -232,19 +232,19 @@
 			       (stream)
   (stream-vertical-spacing stream))
 
-(defoperation stream-cursor-position* basic-extended-output-protocol
+(defoperation stream-cursor-position basic-extended-output-protocol
   ((stream basic-extended-output-protocol))
   (declare (values x y)))
 
-(defoperation stream-set-cursor-position* basic-extended-output-protocol
+(defoperation stream-set-cursor-position basic-extended-output-protocol
   ((stream basic-extended-output-protocol) x y))
 
-;; Like STREAM-SET-CURSOR-POSITION*, but is more conservative about closing
+;; Like STREAM-SET-CURSOR-POSITION, but is more conservative about closing
 ;; the current text output record.
-(defoperation stream-set-cursor-position*-internal basic-extended-output-protocol
+(defoperation stream-set-cursor-position-internal basic-extended-output-protocol
   ((stream basic-extended-output-protocol) x y))
 
-(defoperation stream-increment-cursor-position* basic-extended-output-protocol
+(defoperation stream-increment-cursor-position basic-extended-output-protocol
   ((stream basic-extended-output-protocol) dx dy))
 
 (defoperation stream-ensure-cursor-visible basic-extended-output-protocol
@@ -279,17 +279,17 @@
   ((stream basic-extended-output-protocol) &optional brief-p))
 
 #+Genera
-(defoperation stream-compatible-cursor-position* basic-extended-output-protocol
+(defoperation stream-compatible-cursor-position basic-extended-output-protocol
   ((stream basic-extended-output-protocol) &optional unit)
   (:selector :read-cursorpos))
 
 #+Genera
-(defoperation stream-compatible-set-cursor-position* basic-extended-output-protocol
+(defoperation stream-compatible-set-cursor-position basic-extended-output-protocol
   ((stream basic-extended-output-protocol) x y &optional unit)
   (:selector :set-cursorpos))
 
 #+Genera
-(defoperation stream-compatible-increment-cursor-position* basic-extended-output-protocol
+(defoperation stream-compatible-increment-cursor-position basic-extended-output-protocol
   ((stream basic-extended-output-protocol) x y &optional unit)
   (:selector :increment-cursorpos))
 
@@ -364,10 +364,10 @@
 (defoperation window-drawing-possible window-mixin
   ((window window-mixin)))
 
-(defoperation window-viewport-position* window-mixin
+(defoperation window-viewport-position window-mixin
   ((window window-mixin)))
 
-(defoperation window-set-viewport-position* window-mixin
+(defoperation window-set-viewport-position window-mixin
   ((window window-mixin) x y))
 
 (defoperation redisplay-decorations window-mixin
diff --git a/clim/surround-output.lisp b/clim/surround-output.lisp
index 867a506f..f53abd93 100644
--- a/clim/surround-output.lisp
+++ b/clim/surround-output.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: surround-output.lisp,v 1.3 92/01/31 14:58:50 cer Exp $
+;; $fiHeader: surround-output.lisp,v 1.4 92/02/24 13:08:34 cer Exp $
 
 (in-package :clim-internals)
 
@@ -89,7 +89,7 @@
       (multiple-value-bind (xoff yoff)
 	  (convert-from-relative-to-absolute-coordinates
 	    stream (output-record-parent (output-record-parent body)))
-	(translate-fixnum-positions xoff yoff left top right bottom))
+	(translate-coordinates xoff yoff left top right bottom))
       (with-output-recording-options (stream :draw nil :record t)
 	(with-new-output-record (stream 'standard-sequence-output-record nil
 				 :parent border-record)
diff --git a/clim/table-formatting.lisp b/clim/table-formatting.lisp
index abf2625d..24ce2616 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.4 92/02/24 13:08:36 cer Exp $
+;; $fiHeader: table-formatting.lisp,v 1.5 92/03/04 16:22:19 cer Exp $
 
 (in-package :clim-internals)
 
@@ -170,7 +170,10 @@
 
 (defmethod tree-recompute-extent-1 ((record output-record-mixin))
   (let ((once nil)
-	(min-x 0) (min-y 0) (max-x 0) (max-y 0))
+	(min-x (coordinate 0))
+	(min-y (coordinate 0))
+	(max-x (coordinate 0))
+	(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
@@ -194,9 +197,12 @@
 	(declare (dynamic-extent #'recompute-extent-of-child))
 	(map-over-output-records #'recompute-extent-of-child record))
       (when (null min-x)
-	(setq min-x 0 min-y 0 max-x 0 max-y 0))
+	(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-fixnum-positions x-offset y-offset 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)
       (values min-x min-y max-x max-y))))
 
@@ -242,7 +248,7 @@
 	 (x-spacing (slot-value table 'x-spacing))
 	 (y-spacing (slot-value table 'y-spacing))
 	 (equalize-column-widths (slot-value table 'equalize-column-widths)))
-    (declare (fixnum nrows cells))
+    (declare (type fixnum nrows cells))
     (declare (type coordinate x-spacing y-spacing))
     (labels ((count-rows (row)
 	       (incf nrows)
@@ -265,12 +271,14 @@
       (with-stack-array (column-array ncells :initial-element nil)
 	(let ((x-pos nil)
 	      (y-pos nil)
-	      (row-count 0) (column-count 0)
-	      (total-width 0) (total-height 0))
-	  (declare (fixnum row-count column-count))
+	      (row-count 0)
+	      (column-count 0)
+	      (total-width (coordinate 0))
+	      (total-height (coordinate 0)))
+	  (declare (type fixnum row-count column-count))
 	  (declare (type coordinate total-width total-height))
 	  ;; We always want the table to start at its START-X and START-Y positions.
-	  (multiple-value-setq (x-pos y-pos) (output-record-position* table))
+	  (multiple-value-setq (x-pos y-pos) (output-record-position table))
 	  (macrolet (#-CCL-2 (row-max-height (row-number)
 			       `(svref row-array ,row-number))
 		     #-CCL-2 (column-max-width (column-number)
@@ -305,9 +313,9 @@
 	      (declare (dynamic-extent #'row-mapper))
 	      (funcall table-mapper #'row-mapper table))
 	    (when equalize-column-widths
-	      (let ((column-width 0)
+	      (let ((column-width (coordinate 0))
 		    (n-columns (1+ column-count)))
-		(declare (fixnum n-columns))
+		(declare (type fixnum n-columns))
 		(declare (type coordinate column-width))
 		(dotimes (i n-columns)
 		  (maxf column-width (column-max-width i)))
@@ -338,9 +346,11 @@
 				  (ecase (slot-value cell 'x-alignment)
 				    (:left )
 				    (:right
-				      (setq x-alignment-adjust (- column-width cell-width)))
+				      (setq x-alignment-adjust
+					    (- column-width cell-width)))
 				    (:center
-				      (setq x-alignment-adjust (floor (- column-width cell-width) 2))))
+				      (setq x-alignment-adjust
+					    (floor (- column-width cell-width) 2))))
 				  (ecase (slot-value cell 'y-alignment)
 				    (:top )
 				    (:bottom
@@ -353,7 +363,7 @@
 				      (convert-from-ancestor-to-descendant-coordinates
 					(output-record-parent table) (output-record-parent cell))
 				    (declare (type coordinate x-offset y-offset))
-				    (output-record-set-position*
+				    (output-record-set-position
 				      cell
 				      (+ x-offset total-width  x-alignment-adjust)
 				      (+ y-offset total-height y-alignment-adjust)))
@@ -373,7 +383,7 @@
 (defmethod adjust-multiple-columns ((table standard-table-output-record) stream
 				    &optional n-columns x-spacing)
   (let ((row-count 0))
-    (declare (fixnum row-count))
+    (declare (type fixnum row-count))
     (when (slot-value table 'row-table-p)
       (flet ((row-counter (row)
 	       (declare (ignore row))
@@ -395,31 +405,32 @@
 					      ':multiple-columns-x-spacing)
 		         (stream-string-width stream " ")))
 		   (column-width (+ table-width between-column-margin))
-		   (possible-columns (or n-columns (floor stream-width column-width)))
+		   (possible-columns (or n-columns
+					 (max (floor stream-width column-width) 1)))
 		   (y-spacing (slot-value table 'y-spacing))
 		   (rows-per-column (max 3 (ceiling row-count possible-columns)))
 		   (row-number 0)
-		   (row-x 0)
-		   (row-y 0))
+		   (row-x (coordinate 0))
+		   (row-y (coordinate 0)))
 	      (declare (type coordinate table-width between-column-margin
 				        column-width row-x row-y))
 	      (declare (type fixnum possible-columns rows-per-column row-number))
 	      (flet ((layout-multiple-columns (row)
-		       (multiple-value-bind (rl rt) (bounding-rectangle-position* row)
+		       (multiple-value-bind (rl rt) (bounding-rectangle-position row)
 			 (multiple-value-bind (xoff yoff)
 			     (convert-from-descendant-to-ancestor-coordinates
 			       row (output-record-parent table))
 			   (declare (type coordinate xoff yoff))
-			   (translate-fixnum-positions xoff yoff rl rt))
+			   (translate-coordinates xoff yoff rl rt))
 			 ;; Position the row so that the X position relative to the
 			 ;; original table is preserved, so that :ALIGN-X :RIGHT works
 			 ;;--- ROW-Y needs the same treatment for :ALIGN-Y
-			 (output-record-set-position* row (+ row-x (- rl tleft)) row-y)
+			 (output-record-set-position row (+ row-x (- rl tleft)) row-y)
 			 (incf row-number)
 			 (incf row-y (+ (bounding-rectangle-height row) y-spacing))
 			 (when (zerop (mod row-number rows-per-column))
 			   (setq row-x (+ row-x column-width)
-				 row-y 0)))))
+				 row-y (coordinate 0))))))
 		(declare (dynamic-extent #'layout-multiple-columns))
 		(map-over-table-rows #'layout-multiple-columns table)))))
 	(tree-recompute-extent table)))))
@@ -433,7 +444,7 @@
       #'(lambda (cell)
 	  (with-bounding-rectangle* (left top right bottom) cell
 	    (declare (ignore bottom))
-	    (output-record-set-position* cell x-position top)
+	    (output-record-set-position cell x-position top)
 	    (incf x-position (+ (- right left) x-spacing))))
       row)))
 
@@ -441,15 +452,16 @@
   (declare (ignore stream))
   #+ignore
   (let ((x-spacing (slot-value (output-record-parent column) 'x-spacing))
-	(x-position 0))
+	(x-position (coordinate 0)))
     (map-over-row-cells 
       #'(lambda (cell)
 	  (with-bounding-rectangle* (left top right bottom) cell
 	    (declare (ignore bottom))
-	    (output-record-set-position* cell x-position top)
+	    (output-record-set-position cell x-position top)
 	    (incf x-position (+ (- right left) x-spacing))))
       column)))
 
+;;--- Should this return a COORDINATE?
 (defun process-spacing-arg (stream spacing form &optional clause)
   (cond ((null spacing) nil)
 	((integerp spacing) spacing)
@@ -520,17 +532,18 @@
   ;;--- inline in FORMATTING-CELL it would just work.  We could skip the IF and
   ;;--- just call INVOKE-WITH-NEW-OUTPUT-RECORD...
   (let ((stream (or *original-stream* stream)))
-    (multiple-value-bind (x y) (stream-cursor-position* stream)
-      (if (eq record-type 'standard-cell-output-record)
-	  (with-new-output-record (stream 'standard-cell-output-record nil
-				   :align-x align-x :align-y align-y
-				   :min-width min-width :min-height min-height)
-	    (funcall continuation stream))
-          (with-new-output-record (stream record-type nil
-				   :align-x align-x :align-y align-y
-				   :min-width min-width :min-height min-height)
-	    (funcall continuation stream)))
-      (stream-set-cursor-position* stream x y))))
+    (multiple-value-bind (x y) (stream-cursor-position stream)
+      (prog1
+	(if (eq record-type 'standard-cell-output-record)
+	    (with-new-output-record (stream 'standard-cell-output-record nil
+				     :align-x align-x :align-y align-y
+				     :min-width min-width :min-height min-height)
+	      (funcall continuation stream))
+            (with-new-output-record (stream record-type nil
+				     :align-x align-x :align-y align-y
+				     :min-width min-width :min-height min-height)
+	      (funcall continuation stream)))
+	(stream-set-cursor-position stream x y)))))
 
 (defmethod invoke-formatting-cell :around ((stream output-recording-mixin) continuation
 					   &rest options)
@@ -586,8 +599,8 @@
   (let ((ncolumns (slot-value menu 'n-columns))
 	(nrows (slot-value menu 'n-rows))
 	(ncells 0)
-	(max-cell-width 0)
-	(max-cell-height 0)
+	(max-cell-width (coordinate 0))
+	(max-cell-height (coordinate 0))
 	(x-spacing (slot-value menu 'x-spacing))
 	(y-spacing (slot-value menu 'y-spacing))
 	(initial-spacing (slot-value menu 'initial-spacing))
@@ -629,7 +642,7 @@
 	   ;; could compute this better
 	   (setq nrows 
 		 (max 1
-		      (let ((acc-height 0)
+		      (let ((acc-height (coordinate 0))
 			    (count 0))
 			(loop 
 			  (incf acc-height max-cell-height)
@@ -674,7 +687,7 @@
       (with-stack-array (column-array ncolumns :initial-element nil)
 	(let ((row-count 0)
 	      (column-count 0))
-	  (declare (fixnum row-count column-count))
+	  (declare (type fixnum row-count column-count))
 	  (macrolet (#-CCL-2 (row-height (row-number)
 			       `(svref row-array ,row-number))
 		     #-CCL-2 (column-width (column-number)
@@ -708,12 +721,12 @@
 			*default-minimum-menu-x-spacing*)))
 	    (setq row-count 0
 		  column-count 0)
-	    (multiple-value-bind (left-margin top-margin) (bounding-rectangle-position* menu)
+	    (multiple-value-bind (left-margin top-margin) (bounding-rectangle-position menu)
 	      (declare (type coordinate left-margin top-margin))
-	      (let ((accumulated-height 0)
+	      (let ((accumulated-height (coordinate 0))
 		    (accumulated-width 
 		      (if (or (stream-redisplaying-p stream) initial-spacing)
-			  0
+			  (coordinate 0)
 			  x-spacing)))
 		(declare (type coordinate accumulated-height accumulated-width))
 		(flet ((adjust-cells (cell)
@@ -729,20 +742,24 @@
 			   (ecase (slot-value cell 'x-alignment)
 			     (:left )
 			     (:right
-			       (setq x-alignment-adjust (- column-width cell-width)))
+			       (setq x-alignment-adjust
+				     (- column-width cell-width)))
 			     (:center
-			       (setq x-alignment-adjust (floor (- column-width cell-width) 2))))
+			       (setq x-alignment-adjust
+				     (floor (- column-width cell-width) 2))))
 			   (ecase (slot-value cell 'y-alignment)
 			     (:top )
 			     (:bottom
-			       (setq y-alignment-adjust (- row-height cell-height)))
+			       (setq y-alignment-adjust 
+				     (- row-height cell-height)))
 			     (:center
-			       (setq y-alignment-adjust (floor (- row-height cell-height) 2))))
+			       (setq y-alignment-adjust
+				     (floor (- row-height cell-height) 2))))
 			   (multiple-value-bind (x-offset y-offset)
 			       (convert-from-ancestor-to-descendant-coordinates
 				 (output-record-parent menu) (output-record-parent cell))
 			     (declare (type coordinate x-offset y-offset))
-			     (output-record-set-position*
+			     (output-record-set-position
 			       cell
 			       (+ x-offset left-margin accumulated-width x-alignment-adjust)
 			       (+ y-offset top-margin accumulated-height y-alignment-adjust))))
@@ -752,7 +769,7 @@
 			 (when (= column-count ncolumns)
 			   (setf accumulated-width 
 				 (if (or (stream-redisplaying-p stream) initial-spacing)
-				     0
+				     (coordinate 0)
 				     x-spacing))
 			   (incf accumulated-height (row-height row-count))
 			   (incf accumulated-height y-spacing)
diff --git a/clim/text-formatting.lisp b/clim/text-formatting.lisp
index e61e6144..bd45b929 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.5 92/03/04 16:22:21 cer Exp $
+;; $fiHeader: text-formatting.lisp,v 1.6 92/03/10 10:12:55 cer Exp $
 
 (in-package :clim-internals)
 
@@ -102,8 +102,8 @@
     (stream-write-string stream buffer)
     (setf (fill-pointer buffer) 0)
     ;; Move to the next line if necessary, writing the prefix string
-    ;;--- STREAM-CURSOR-POSITION* is the wrong thing to look at
-    (when (> (stream-cursor-position* stream) fill-width)
+    ;;--- STREAM-CURSOR-POSITION is the wrong thing to look at
+    (when (> (stream-cursor-position stream) fill-width)
       (stream-terpri stream)
       (filling-stream-handle-line-break filling-stream))
     (let ((*original-stream* (or *original-stream* filling-stream)))
@@ -187,8 +187,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-position indenting-record)
+      (output-record-set-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 67b12a0d..42a634c4 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.2 92/03/04 16:22:22 cer Exp $
+;; $fiHeader: text-recording.lisp,v 1.3 92/03/10 10:12:56 cer Exp $
 
 (in-package :clim-internals)
 
@@ -78,7 +78,7 @@
 		      (text-style-descent text-style #-Silica stream #+Silica port)))
 	 (glyph-buffer (stream-output-glyph-buffer stream))
 	 (color (slot-value record 'ink)))
-    (declare (fixnum start end))
+    (declare (type fixnum start end))
     (#-Silica progn
      #+Silica with-sheet-medium #+Silica (medium stream)
      (macrolet
@@ -89,9 +89,7 @@
 				  new-cursor-x new-baseline new-height font)
 		(stream-scan-string-for-writing stream #+Silica medium
 						string start ,end-position text-style
-						cursor-x
-						;;--- MOST-POSITIVE-FIXNUM loses
-						most-positive-fixnum 
+						cursor-x +largest-coordinate+
 						glyph-buffer)
 	      ;; GLYPH-BUFFER NIL => pass the string to the port-specific code.
 	      #-Silica
@@ -119,15 +117,14 @@
 		       (multiple-value-bind (new-cursor-x new-cursor-y)
 			   (stream-draw-lozenged-character
 			     stream write-char cursor-x cursor-y new-baseline new-height
-			     ;;--- MOST-POSITIVE-FIXNUM loses
-			     text-style most-positive-fixnum nil t)
+			     text-style +largest-coordinate+ nil t)
 			 (setf cursor-x new-cursor-x
 			       cursor-y new-cursor-y))))
 		(incf start))))))
       (multiple-value-bind (cursor-x cursor-y) 
-	  (output-record-start-cursor-position* record)
+	  (output-record-start-cursor-position record)
 	(declare (type coordinate cursor-x cursor-y))
-	(translate-fixnum-positions x-offset y-offset cursor-x cursor-y)
+	(translate-coordinates x-offset y-offset cursor-x cursor-y)
 	(do-it end)
 	#-Silica
 	(when (slot-value record 'wrapped-p)
@@ -145,7 +142,7 @@
 	 (baseline (slot-value record 'baseline))
 	 (glyph-buffer (stream-output-glyph-buffer stream))
 	 (color (slot-value record 'ink)))
-    (declare (fixnum start end))
+    (declare (type fixnum start end))
     (#-Silica progn
      #+Silica with-sheet-medium #+Silica (medium stream)
      (macrolet
@@ -156,9 +153,7 @@
 				  new-cursor-x new-baseline new-height font)
 		(stream-scan-string-for-writing stream #+Silica medium
 						string start ,end-position text-style
-						cursor-x
-						;;--- LOSES
-						most-positive-fixnum 
+						cursor-x +largest-coordinate+
 						glyph-buffer)
 	      #-Silica
 	      (if glyph-buffer
@@ -185,15 +180,14 @@
 		       (multiple-value-bind (new-cursor-x new-cursor-y)
 			   (stream-draw-lozenged-character
 			     stream write-char cursor-x cursor-y new-baseline new-height
-			     ;;--- LOSES
-			     text-style most-positive-fixnum nil t)
+			     text-style +largest-coordinate+ nil t)
 			 (setf cursor-x new-cursor-x
 			       cursor-y new-cursor-y))))
 		(incf start))))))
       (multiple-value-bind (cursor-x cursor-y) 
-	  (output-record-start-cursor-position* record)
+	  (output-record-start-cursor-position record)
 	(declare (type coordinate cursor-x cursor-y))
-	(translate-fixnum-positions x-offset y-offset cursor-x cursor-y)
+	(translate-coordinates x-offset y-offset cursor-x cursor-y)
 	(dolist (text-style-change (slot-value record 'text-style-changes))
 	  (let ((new-text-style (car text-style-change))
 		(change-position (cdr text-style-change)))
@@ -216,7 +210,7 @@
 	  (multiple-value-bind (xoff yoff)
 	      (convert-from-descendant-to-ancestor-coordinates record parent)
 	    (declare (type coordinate xoff yoff))
-	    (translate-fixnum-positions xoff yoff old-left old-top old-right old-bottom)
+	    (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)))
@@ -226,7 +220,7 @@
 					     text-string start end text-style
 					     new-width new-height new-baseline)
   (declare (ignore text-style new-baseline))
-  (declare (fixnum start end))
+  (declare (type fixnum start end))
   (when (>= start end)
     (return-from add-string-output-to-text-record))
   (let* ((count (the fixnum (- end start)))
@@ -243,7 +237,7 @@
 (defmethod add-string-output-to-text-record ((record styled-text-output-record)
 					     text-string start end text-style
 					     new-width new-height new-baseline)
-  (declare (fixnum start end))
+  (declare (type fixnum start end))
   (when (>= start end)
     (return-from add-string-output-to-text-record))
   (let* ((count (the fixnum (- end start)))
@@ -288,11 +282,11 @@
 
 (defmethod prepare-text-record-for-appending
     ((record standard-text-output-record) space-needed style)
-  (declare (fixnum space-needed))
+  (declare (type fixnum space-needed))
   (declare (ignore style))
   (let* ((string (slot-value record 'string))
 	 (fill-pointer (fill-pointer string)))
-    (declare (fixnum fill-pointer))
+    (declare (type fixnum fill-pointer))
     (when (> (the fixnum (+ fill-pointer space-needed)) (array-dimension string 0))
       (setf string (adjust-array string (the fixnum (+ fill-pointer space-needed 16))))
       (setf (slot-value record 'string) string))
@@ -300,7 +294,7 @@
 
 (defmethod prepare-text-record-for-appending
     ((record styled-text-output-record) space-needed style)
-  (declare (fixnum space-needed))
+  (declare (type fixnum space-needed))
   (with-slots (initial-text-style current-text-style
 	       text-style-changes baseline) record
     (let* ((string (slot-value record 'string))
@@ -341,18 +335,18 @@
 	  ;; make sure that old bounding-rect is the same relative position from
 	  ;; old-start-position as the bounding-rect is from start-position
 	  (multiple-value-bind (delta-x delta-y)
-	      (multiple-value-bind (ex ey) (bounding-rectangle-position* text)
+	      (multiple-value-bind (ex ey) (bounding-rectangle-position text)
 		(declare (type coordinate ex ey))
 		(multiple-value-bind (sx sy) 
-		    (output-record-start-cursor-position* text)
+		    (output-record-start-cursor-position text)
 		  (declare (type coordinate sx sy))
-		  (position-difference* ex ey sx sy)))
+		  (position-difference ex ey sx sy)))
 	    (declare (type coordinate delta-x delta-y))
 	    (multiple-value-bind (old-start-x old-start-y)
-		(multiple-value-bind (px py) (bounding-rectangle-position* match)
+		(multiple-value-bind (px py) (bounding-rectangle-position match)
 		  (declare (type coordinate px py))
-		  (position-difference* px py delta-x delta-y))
-	      (output-record-set-old-start-cursor-position*
+		  (position-difference px py delta-x delta-y))
+	      (output-record-set-old-start-cursor-position
 		text old-start-x old-start-y))))))))
 
 (defmethod recompute-contents-ok ((text styled-text-output-record))
@@ -380,18 +374,18 @@
 	  ;; make sure that old bounding-rect is the same relative position from
 	  ;; old-start-position as the bounding-rect is from start-position
 	  (multiple-value-bind (delta-x delta-y)
-	      (multiple-value-bind (ex ey) (bounding-rectangle-position* text)
+	      (multiple-value-bind (ex ey) (bounding-rectangle-position text)
 		(declare (type coordinate ex ey))
 		(multiple-value-bind (sx sy) 
-		    (output-record-start-cursor-position* text)
+		    (output-record-start-cursor-position text)
 		  (declare (type coordinate sx sy))
-		  (position-difference* ex ey sx sy)))
+		  (position-difference ex ey sx sy)))
 	    (declare (type coordinate delta-x delta-y))
 	    (multiple-value-bind (old-start-x old-start-y)
-		(multiple-value-bind (px py) (bounding-rectangle-position* match)
+		(multiple-value-bind (px py) (bounding-rectangle-position match)
 		  (declare (type coordinate px py))
-		  (position-difference* px py delta-x delta-y))
-	      (output-record-set-old-start-cursor-position*
+		  (position-difference px py delta-x delta-y))
+	      (output-record-set-old-start-cursor-position
 		text old-start-x old-start-y))))))))
 
 (defmethod get-text-output-record ((stream output-recording-mixin) style)
@@ -411,12 +405,12 @@
 		       (make-standard-text-output-record (medium-ink stream) string))))
       (setf (stream-text-output-record stream) record)
       (multiple-value-bind (abs-x abs-y)
-	  (point-position*
+	  (point-position
 	    (stream-output-history-position stream))
 	(declare (type coordinate abs-x abs-y))
-	(multiple-value-bind (cx cy) (stream-cursor-position* stream)
+	(multiple-value-bind (cx cy) (stream-cursor-position stream)
 	  (declare (type coordinate cx cy))
-	  (output-record-set-start-cursor-position*
+	  (output-record-set-start-cursor-position
 	    record (- cx abs-x) (- cy abs-y))))
       ;; Moved to STREAM-CLOSE-TEXT-OUTPUT-RECORD, since we don't need this thing
       ;; in the history until then.  This should save an extra recompute-extent call
@@ -453,7 +447,7 @@
 (defun find-text-baseline (record stream)
   ;; This finds the lowest baseline of the text in RECORD, which will be slower than, say,
   ;; the first baseline but more likely to look good with misaligned things.
-  (let ((baseline 0)
+  (let ((baseline (coordinate 0))
 	(style (medium-default-text-style stream))
 	#+Silica (port (port stream)))
     (declare (type coordinate baseline))
@@ -468,13 +462,13 @@
 			    (- (text-style-height style #-Silica stream #+Silica port)
 			       (text-style-descent style #-Silica stream #+Silica port)))))
 		 (t
-		   (multiple-value-bind (xoff yoff) (output-record-position* record)
+		   (multiple-value-bind (xoff yoff) (output-record-position record)
 		     (declare (type coordinate yoff))
 		     (declare (ignore xoff))
 		     (map-over-output-records #'find-or-recurse record
 					      0 0 (+ yoff y-offset)))))))
       (declare (dynamic-extent #'find-or-recurse))
-      (find-or-recurse record 0))
+      (find-or-recurse record (coordinate 0)))
     baseline)) 
 
 ;; Copy just the text from the window to the stream.  If REGION is supplied,
@@ -489,7 +483,7 @@
 			    :fill-pointer 0 :adjustable t :initial-element nil)))
     (labels ((collect (record x-offset y-offset)
 	       (multiple-value-bind (start-x start-y)
-		   (output-record-start-cursor-position* record)
+		   (output-record-start-cursor-position record)
 		 (translate-positions x-offset y-offset start-x start-y)
 		 (when (typep record 'standard-text-output-record)
 		   (vector-push-extend (list* start-y start-x (slot-value record 'string))
@@ -498,12 +492,12 @@
 		   #'collect record region 
 		   (- x-offset) (- y-offset) start-x start-y))))
       (declare (dynamic-extent #'collect))
-      (collect history 0 0))
+      (collect history (coordinate 0) (coordinate 0)))
     (sort array #'(lambda (r1 r2)
 		    (or (< (first r1) (first r2))
 			(and (= (first r1) (first r2))
 			     (< (second r1) (second r2))))))
-    (let ((current-x 0)
+    (let ((current-x (coordinate 0))
 	  (current-y (first (aref array 0))))
       (dotimes (i (fill-pointer array))
 	(let* ((item (aref array i))
@@ -513,7 +507,7 @@
 	    (dotimes (j (round (- y current-y) line-height))
 	      #-(or Allegro Minima) (declare (ignore j))
 	      (terpri stream)
-	      (setq current-x 0))
+	      (setq current-x (coordinate 0)))
 	    (setq current-y y))
 	  (unless (= x current-x)
 	    (dotimes (j (round (- x current-x) char-width))
diff --git a/clim/tracking-pointer.lisp b/clim/tracking-pointer.lisp
index dbe30546..cfa86f13 100644
--- a/clim/tracking-pointer.lisp
+++ b/clim/tracking-pointer.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: tracking-pointer.lisp,v 1.5 92/03/04 16:22:24 cer Exp $
+;; $fiHeader: tracking-pointer.lisp,v 1.6 92/03/10 10:12:59 cer Exp $
 
 (in-package :clim-internals)
 
@@ -148,9 +148,9 @@
 	     ;; Genera's ancient window system cannot be easily cajoled into
 	     ;; doing this, so we'll do it by hand right here.
 	     (make-release-event (window pointer buttons)
-	       (multiple-value-bind (px py) (pointer-position* pointer)
+	       (multiple-value-bind (px py) (pointer-position pointer)
 		 (multiple-value-bind (ox oy)
-		     #+Silica (values 0 0)
+		     #+Silica (values (coordinate 0) (coordinate 0))
 		     #-Silica (window-offset window)
 		   (let ((wx (- px ox))
 			 (wy (- py oy))
@@ -165,8 +165,8 @@
 				    :x wx :y wy)))
 		       (when transformp
 			 (multiple-value-bind (tx ty)
-			     (transform-point* (medium-transformation window)
-					       wx wy)
+			     (transform-position (medium-transformation window)
+						 wx wy)
 			   (setq wx (floor tx)
 				 wy (floor ty))))
 		       (values event wx wy)))))))
@@ -185,7 +185,7 @@
 		(when (or motion-function presentation-motion-function highlight)
 		  (when multiple-window
 		    (setq current-window (or (pointer-window pointer) (pointer-root pointer))))
-		  (multiple-value-bind (x y) (pointer-position* pointer)
+		  (multiple-value-bind (x y) (pointer-position pointer)
 		    (when moved-p
 		      (setq moved-p nil)
 		      (setq last-x x last-y y
@@ -193,7 +193,7 @@
 		      ;; Pointer position is in root coordinates
 		      ;;--- What to do about window offset and drawing-to-surface-coordinates?
 		      (multiple-value-bind (ox oy) 
-			  #+Silica (values 0 0)
+			  #+Silica (values (coordinate 0) (coordinate 0))
 			  #-Silica (window-offset current-window)
 			(declare (type coordinate ox oy))
 			(let ((wx (- x ox))
@@ -220,8 +220,8 @@
 			  (when motion-function
 			    (when transformp
 			      (multiple-value-bind (tx ty)
-				  (transform-point* (medium-transformation current-window)
-						    wx wy)
+				  (transform-position (medium-transformation current-window)
+						      wx wy)
 				(setq wx (floor tx)
 				      wy (floor ty))))
 			    (funcall motion-function
@@ -278,8 +278,8 @@
 				    (wy py))
 			       (when transformp
 				 (multiple-value-bind (tx ty)
-				     (transform-point* (medium-transformation current-window)
-						       px py)
+				     (transform-position (medium-transformation current-window)
+							 px py)
 				   (setq wx (floor tx)
 					 wy (floor ty))))
 			       (typecase gesture
diff --git a/clim/window-stream.lisp b/clim/window-stream.lisp
index 80d8e687..301390f2 100644
--- a/clim/window-stream.lisp
+++ b/clim/window-stream.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: window-stream.lisp,v 1.4 92/02/24 13:08:55 cer Exp $
+;; $fiHeader: window-stream.lisp,v 1.5 92/03/10 10:13:02 cer Exp $
 
 (in-package :clim-internals)
 
@@ -157,13 +157,16 @@
     (when bottom
       (error "Can't supply both :BOTTOM and :HEIGHT."))
     (setq bottom (+ top height)))
-  (make-instance 'window-stream :parent parent :min-x left :min-y top :max-x right :max-y bottom))
+  (make-instance 'window-stream 
+		 :parent parent
+		 :left left :top top
+		 :right right :bottom bottom))
 
 
 #-Silica (progn
 
 ;;; For hooking up with host window decorations.
-(defmethod window-set-viewport-position* :after ((window window-stream) new-x new-y)
+(defmethod window-set-viewport-position :after ((window window-stream) new-x new-y)
   (declare (ignore new-x new-y))
   (redisplay-decorations window))
 
@@ -171,7 +174,7 @@
   (declare (ignore left top right bottom))
   (redisplay-decorations window))
 
-(defmethod bounding-rectangle-set-position* :after ((window window-stream) left top)
+(defmethod bounding-rectangle-set-position :after ((window window-stream) left top)
   (declare (ignore left top))
   (redisplay-decorations window))
 
diff --git a/clx/clx-frames.lisp b/clx/clx-frames.lisp
index c3e7c851..be4fc79d 100644
--- a/clx/clx-frames.lisp
+++ b/clx/clx-frames.lisp
@@ -1,9 +1,10 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: clx-frames.lisp,v 1.3 92/03/04 16:20:49 cer Exp $
+
 (in-package :clx-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved."
-;;; $fiHeader: clx-frames.lisp,v 1.3 92/03/04 16:20:49 cer Exp Locker: cer $
 
 
 (defclass clx-frame-manager (standard-frame-manager)
@@ -20,9 +21,9 @@
 	  (vertically ()
 	    (outlining ()
 	      (make-pane 'command-menu-pane
-			    :display-function 
-			      `(display-command-menu :command-table ,menu-bar)
-			    :width :compute :height :compute))
+			 :display-function 
+			   `(display-command-menu :command-table ,menu-bar)
+			 :width :compute :height :compute))
 	    pane))
 	pane)))
 
diff --git a/clx/clx-gadgets.lisp b/clx/clx-gadgets.lisp
index 3cbc9567..a8f23e36 100644
--- a/clx/clx-gadgets.lisp
+++ b/clx/clx-gadgets.lisp
@@ -1,9 +1,10 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: clx-gadgets.lisp,v 1.3 92/03/04 16:20:50 cer Exp $
+
 (in-package :clx-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved."
-;;; $fiHeader: clx-gadgets.lisp,v 1.3 92/03/04 16:20:50 cer Exp Locker: cer $
 
 (defmethod make-pane-class ((framem clx-frame-manager) class &rest options)
   (declare (ignore options))
@@ -31,17 +32,18 @@
 			 ))))
 
 (defmethod make-pane-1 ((framem clx-frame-manager)
-			   frame abstract-type &rest options)
+			frame abstract-type &rest options)
   (let ((type (apply #'make-pane-class framem abstract-type options)))
     (if type
 	(apply #'make-instance type
 	       :frame frame
 	       :frame-manager framem
-	       (apply #'make-pane-arglist
-		      framem abstract-type options))
+	       (apply #'make-pane-arglist framem abstract-type options))
 	(call-next-method))))
 
 (defmethod make-pane-arglist (realizer type &rest options)
   (declare (ignore realizer type))
   options)
 
+;;--- This isn't really right.
+(defmethod sheet-shell (sheet) sheet)
diff --git a/clx/clx-medium.lisp b/clx/clx-medium.lisp
index be9743a1..613288dc 100644
--- a/clx/clx-medium.lisp
+++ b/clx/clx-medium.lisp
@@ -1,9 +1,10 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: clx-medium.lisp,v 1.4 92/03/10 10:12:06 cer Exp $
+
 (in-package :clx-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved."
-;;; $fiHeader: clx-medium.lisp,v 1.3 92/03/04 16:20:52 cer Exp $
 
 
 (defclass clx-medium (medium)
@@ -467,7 +468,8 @@
     (let ((minx most-positive-fixnum)
 	  (miny most-positive-fixnum)
 	  (points (copy-list points)))
-      (declare (fixnum minx miny))
+      ;; These really are fixnums, since we're fixing coordinates below
+      (declare (type fixnum minx miny))
       (do* ((points points (cddr points)))
 	   ((null points))
 	(let ((x (first points))
@@ -682,8 +684,9 @@
       (xlib:copy-area (realize-pixmap port source) gcontext
 		      left 
 		      (- (pixmap-height source) (+ bottom height))
-		      width height
-		      drawable (integerize-coordinate x) (integerize-coordinate y)))))
+		      (fix-coordinate width) (fix-coordinate height)
+		      drawable 
+		      (fix-coordinate x) (fix-coordinate y)))))
 
 (defmethod copy-area
 	   ((medium clg-display-medium) x y 
@@ -702,10 +705,10 @@
 			      (+ left width) (+ bottom height))))
     (xlib:with-gcontext (gcontext :function boole)
       (xlib:copy-area (slot-value source 'drawable) gcontext
-		      (integerize-coordinate left)
-		      (integerize-coordinate bottom)
+		      (fix-coordinate left) (fix-coordinate bottom)
 		      (round width) (round height)	;--- round???
-		      drawable (integerize-coordinate x) (integerize-coordinate y)))))
+		      drawable
+		      (fix-coordinate x) (fix-coordinate y)))))
 
 (defmethod copy-area ((pixmap pixmap) dst-x dst-y 
 		      (medium clg-display-medium) src-x src-y src-w src-h
@@ -719,7 +722,7 @@
     (let ((xbm (realize-pixmap port pixmap)))
       (xlib:with-gcontext (gcontext :function boole)
 	(xlib:copy-area drawable gcontext
-			(integerize-coordinate src-x) (integerize-coordinate src-y)
+			(fix-coordinate src-x) (fix-coordinate src-y)
 			src-w src-h
 			xbm dst-x (- (pixmap-height pixmap) dst-y src-h))))))
 ||#
diff --git a/clx/clx-mirror.lisp b/clx/clx-mirror.lisp
index adec7771..59f6be17 100644
--- a/clx/clx-mirror.lisp
+++ b/clx/clx-mirror.lisp
@@ -1,9 +1,10 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: clx-mirror.lisp,v 1.3 92/03/04 16:20:54 cer Exp $
+
 (in-package :clx-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved.
-;;; $fiHeader: clx-mirror.lisp,v 1.2 92/02/24 13:23:50 cer Exp $
  Portions copyright (c) 1991, 1992 International Lisp Associates."
 
 
@@ -11,7 +12,7 @@
   (with-slots (display screen) port
     (multiple-value-bind (left top right bottom)
 	(sheet-native-region* sheet)
-      (integerize-coordinates left top right bottom)
+      (fix-coordinates left top right bottom)
       (let* ((clx-parent (sheet-mirror sheet))
 	     (mirror
 	       (xlib:create-window 
@@ -140,10 +141,10 @@
 				    left top right bottom)
   (let* ((mirror (sheet-mirror sheet))
 	 (display (port-display port))
-	 (w (integerize-coordinate (- right left)))
-	 (h (integerize-coordinate (- bottom top)))
-	 (x (integerize-coordinate left))
-	 (y (integerize-coordinate top)))
+	 (w (fix-coordinate (- right left)))
+	 (h (fix-coordinate (- bottom top)))
+	 (x (fix-coordinate left))
+	 (y (fix-coordinate top)))
     (xlib:with-display (display)
       (setf (xlib:drawable-x mirror) x
 	    (xlib:drawable-y mirror) y
diff --git a/clx/clx-port.lisp b/clx/clx-port.lisp
index c87861d7..aac6b495 100644
--- a/clx/clx-port.lisp
+++ b/clx/clx-port.lisp
@@ -1,9 +1,10 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: clx-port.lisp,v 1.4 92/03/10 10:12:08 cer Exp $
+
 (in-package :clx-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved.
-;;; $fiHeader: clx-port.lisp,v 1.4 92/03/10 10:12:08 cer Exp Locker: cer $
  Portions copyright (c) 1991, 1992 International Lisp Associates."
 
 
@@ -564,8 +565,8 @@
 
 (defmethod set-cursor-location ((port clx-port) sheet x y)
   (xlib:warp-pointer (sheet-mirror sheet)
-		     (integerize-coordinate x)
-		     (integerize-coordinate y)))
+		     (fix-coordinate x) (fix-coordinate y)))
+
 
 
 ;;--- Doesn't this need a sheet/stream argument?
diff --git a/demo/address-book.lisp b/demo/address-book.lisp
index 0b8c804f..d260cdfb 100644
--- a/demo/address-book.lisp
+++ b/demo/address-book.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: address-book.lisp,v 1.3 92/03/24 19:38:14 cer Exp Locker: cer $
+;; $fiHeader: address-book.lisp,v 1.4 92/04/10 14:27:28 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
@@ -38,18 +38,16 @@
   (setq *addresses* (sort *addresses* #'string-lessp :key #'address-last-name)))
 
 (progn
-  (add-address (make-address :name "Bill York"
-			     :address "ILA, Mountain View"
-			     :number "415-968-3656"))
-  (add-address (make-address :name "Dennis Doughty"
-			     :address "ILA, Cambridge"
-			     :number "617-576-1151"))
-  (add-address (make-address :name "Mark Son-Bell"
-			     :address "ILA, Cambridge"
-			     :number "617-576-1151"))
-  (add-address (make-address :name "Richard Lamson"
-			     :address "ILA, San Francisco"
-			     :number "415-661-5477")))
+  (add-address (make-address :name "Chris Richardson"
+			     :address "Franz Inc"
+			     :number "510-548-3600"))
+  (add-address (make-address :name "John Irwin"
+			     :address "Franz Inc"
+			     :number "510-548-3600"))
+  (add-address (make-address :name "Scott Mckay"
+			     :address "Symbolics Inc"
+			     :number "617-221-xxxx"))
+)
 
 ;;; --------------------------------
 ;;; Define the user interface here.
@@ -94,34 +92,32 @@
       (write-string number stream))))
 
 ;;; Define the application-frame for our application
-
 (define-application-frame address-book
-    ()
-  ;; This application has two state variables, the currently displayed
-  ;; address and the window from which user queries should be read.
-  ((current-address :initform nil)
-   (interaction-pane )
-   (name-pane))
-  
+			  ()
+    ;; This application has two state variables, the currently displayed
+    ;; address and the window from which user queries should be read.
+    ((current-address :initform nil)
+     (interaction-pane )
+     (name-pane))
   (:panes
-   (interactor
-    (scrolling ()
-	       (make-pane 'interactor-pane)))
-   (address
-    (scrolling ()
-	       (make-pane 'application-pane
-			     :incremental-redisplay t
-			     :display-function
-			     'display-current-address)))
-   (names
-    (scrolling ()
-	       (make-pane 'application-pane
-			     :incremental-redisplay t
-			     :display-function 'display-names))))
+    (interactor
+      (scrolling ()
+        (make-pane 'interactor-pane)))
+    (address
+      (scrolling ()
+        (make-pane 'application-pane
+		   :incremental-redisplay t
+		   :display-function 'display-current-address)))
+    (names
+      (scrolling ()
+        (make-pane 'application-pane
+		   :incremental-redisplay t
+		   :display-function 'display-names))))
   (:layout
-   (default
-       (vertically ()
-	(horizontally () address names)
+    (default
+      (vertically ()
+        (horizontally ()
+	  address names)
 	interactor))))
 
 ;;; This is the display-function for the upper-left pane, which specified 
diff --git a/demo/cad-demo.lisp b/demo/cad-demo.lisp
index 23757179..c82e9929 100644
--- a/demo/cad-demo.lisp
+++ b/demo/cad-demo.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cad-demo.lisp,v 1.4 92/03/24 19:38:15 cer Exp Locker: cer $
+;; $fiHeader: cad-demo.lisp,v 1.5 92/04/10 14:27:29 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
@@ -21,23 +21,23 @@
 
 (defmethod bounding-rectangle* ((thing basic-thing))
   (with-slots (x y size) thing
-    #-Silica (declare (fixnum x y size))
+    (declare (type coordinate x y size))
     (values x y (+ x size) (+ y size))))
 
-(defmethod region-contains-point*-p ((thing basic-thing) x y)
+(defmethod region-contains-position-p ((thing basic-thing) x y)
   (with-bounding-rectangle* (left top right bottom) thing
     (and (<= left x)
 	 (<= top y)
 	 (>= right x)
 	 (>= bottom y))))
 
-(defmethod output-record-start-cursor-position* ((thing basic-thing))
+(defmethod output-record-start-cursor-position ((thing basic-thing))
   (values 0 0))
 
-;; NEW-X and NEW-Y had better be fixnums
-(defmethod output-record-set-position* ((thing basic-thing) new-x new-y)
+(defmethod output-record-set-position ((thing basic-thing) new-x new-y)
   (with-slots (x y) thing
-    (setf x new-x y new-y)))
+    (setf x (coordinate new-x)
+	  y (coordinate new-y))))
 
 (defmethod map-over-output-records-overlapping-region
 	   (function (thing basic-thing) region
@@ -46,7 +46,7 @@
   (declare (dynamic-extent continuation-args))
   nil)
 
-(defmethod map-over-output-records-containing-point*
+(defmethod map-over-output-records-containing-position
 	   (function (thing basic-thing) x y
 	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
   (declare (ignore x y function x-offset y-offset continuation-args))
@@ -80,10 +80,10 @@
   (with-slots (x y) thing
     (values x y)))
 
-;; NEW-X and NEW-Y had better be fixnums
 (defmethod move ((thing basic-thing) new-x new-y)
   (with-slots (x y) thing
-    (setf x new-x y new-y)))
+    (setf x (coordinate new-x)
+	  y (coordinate new-y))))
 
 
 ;;;****************************************************************
@@ -133,7 +133,7 @@
 (defmethod bounding-rectangle* ((conn connection))
   (let ((fudge 2))
     (with-slots (x y size) conn
-      #-Silica (declare (fixnum x y size))
+      (declare (type coordinate x y size))
       ;; size is a radius, but make the box larger so that connections
       ;; are easier to point to
       (values (- x size fudge) (- y size fudge)
@@ -297,10 +297,10 @@
     ;; Not (- X SIZE) because the component is a half-circle
     (values x (- y size) (+ x size) (+ y size))))
 
-;; NEW-X and NEW-Y had better be fixnums
-(defmethod output-record-set-position* ((thing basic-thing) new-x new-y)
+(defmethod output-record-set-position ((thing basic-thing) new-x new-y)
   (with-slots (x y size) thing
-    (setf x new-x y (+ new-y size))))
+    (setf x (coordinate new-x)
+	  y (coordinate (+ new-y size)))))
 
 
 (defmethod presentation-type ((comp component))
@@ -499,13 +499,11 @@
       (cond ((eq ink +background-ink+)
 	     ;;--- gee, am I getting carried away?
 	     (multiple-value-bind (nx ny)
-		 #+ignore drawing-surface-to-viewport-coordinates
-		 (values x y)
-		 (decf ny *component-size*)
-		 (with-sheet-medium (medium stream)
-		   (draw-rectangle* medium
-				    (- nx 10) (- ny 10) nx (+ ny 20)
-				    :ink +background-ink+))))
+ 		 (values x (- y *component-size*))
+	       (with-sheet-medium (medium stream)
+		 (draw-rectangle* medium
+				  (- nx 10) (- ny 10) nx (+ ny 20)
+				  :ink +background-ink+))))
 	    (t
 	     (draw-text* stream name (- x 10) (- y 10)))))))
 
@@ -531,33 +529,27 @@
 
 ;;; First define a "application" that manages the application's state variables
 ;;; and defines a high-level division of screen real estate.
-
-
-
 (define-application-frame cad-demo
 			  (standard-application-frame output-record)
-  ((object-list :initform nil))
+    ((object-list :initform nil))
   (:panes
-   (design-area 
-    (make-pane 'application-pane)))
+    (design-area 
+      (make-pane 'application-pane)))
   (:pointer-documentation t)
   (:layout
-   (:default
-       (scrolling ()
-		  design-area)))
+    (default
+      (scrolling ()
+	design-area)))
   (:top-level
     (default-frame-top-level :partial-command-parser cad-demo-partial-command-parser)))
 
-;;--- I am amazed every day by something
-;; and this was it today !!!!
-
 (defmethod initialize-instance :around ((cd cad-demo) &key)
   (call-next-method)
   (let ((dp (get-frame-pane cd 'design-area)))
     ;;--- kludge this one pane
     (setf (stream-output-history dp) cd)
     (setf (stream-recording-p dp) nil)))
-  
+
 (defun cad-demo-partial-command-parser (partial-command command-table stream start-location)
   (let ((name (command-name partial-command)))
     (if (eq name 'com-create-component)
@@ -596,16 +588,16 @@
 		object region x-offset y-offset))
       (apply function object continuation-args))))
 
-(defmethod map-over-output-records-containing-point*
+(defmethod map-over-output-records-containing-position
 	   (function (cd cad-demo) x y
 	    &optional (x-offset 0) (y-offset 0) &rest continuation-args)
   (declare (dynamic-extent continuation-args))
   (translate-positions x-offset y-offset x y)
   (dolist (object (slot-value cd 'object-list))
-    (when (region-contains-point*-p object x y)
+    (when (region-contains-position-p object x y)
       (apply function object continuation-args))))
 
-(defmethod output-record-start-cursor-position* ((record cad-demo))
+(defmethod output-record-start-cursor-position ((record cad-demo))
   (values 0 0))
 
 (defmethod add-output-record (element (record cad-demo))
@@ -623,7 +615,7 @@
     (setq region nil))
   (multiple-value-bind (rl rt rr rb)
       (and region (bounding-rectangle* region))
-    (multiple-value-bind (xoff yoff) (output-record-position* record)
+    (multiple-value-bind (xoff yoff) (output-record-position record)
       (map-over-output-records-overlapping-region
 	#'(lambda (element)
 	    (with-bounding-rectangle* (left top right bottom) element
@@ -680,7 +672,6 @@
 ;(make-component-prototypes)
 
 ;;; Return the class name of the selected component
-
 (defun select-component (parent)
   (labels ((draw-icon-menu (menu presentation-type)
 	     (formatting-table (menu :x-spacing 5)
@@ -691,8 +682,8 @@
 		       (progn ;; (with-user-coordinates (menu)
 			 (draw-self icon menu)
 			 (multiple-value-bind (x y)
-			     (stream-cursor-position* menu)
-			   (stream-set-cursor-position*
+			     (stream-cursor-position menu)
+			   (stream-set-cursor-position
 			     menu
 			     ;; fudge for the fact that the presentation encloses the
 			     ;; half of the circle that's invisible
@@ -722,8 +713,8 @@
 		       (with-user-coordinates (menu)
 			 (draw-self icon menu)
 			 (multiple-value-bind (x y)
-			     (stream-cursor-position* menu)
-			   (stream-set-cursor-position*
+			     (stream-cursor-position menu)
+			   (stream-set-cursor-position
 			     menu
 			     ;; fudge for the fact that the presentation encloses the
 			     ;; half of the circle that's invisible
@@ -877,7 +868,7 @@
     ((output 'output :gesture :describe))
   (let ((comp (connection-component output))
 	(win (get-frame-pane *application-frame* 'design-area)))
-    (stream-set-cursor-position* win 0 0)
+    (stream-set-cursor-position win 0 0)
     (draw-rectangle* win 0 0 800 20 :ink +background-ink+)
     (with-text-style (win '(:sans-serif :bold :very-large))
       (format win "~A" (equation-part comp)))))
@@ -889,18 +880,16 @@
 
 (define-cad-demo-command (com-exit-CAD-demo :menu "Exit" :keystroke #\X)
     ()
-  ;; assume called via run-cad-demo
   (frame-exit *application-frame*))
 
-;;;------------
-;;; Right now there is only one
-;(define-cad-demo-command (com-swap-layouts :menu "Swap Layouts")
-;    ()
-;  (let ((current-layout (frame-current-layout *application-frame*)))
-;    (setf (frame-current-layout *application-frame*)
-;	  (case current-layout
-;	    (main 'other)
-;	    (other 'main)))))
+#+++ignore	;--- right now there is only one layout
+(define-cad-demo-command (com-swap-layouts :menu "Swap Layouts")
+    ()
+  (let ((current-layout (frame-current-layout *application-frame*)))
+    (setf (frame-current-layout *application-frame*)
+	  (case current-layout
+	    (main 'other)
+	    (other 'main)))))
 
 #||
 
@@ -919,14 +908,9 @@ but first get better menu formatting!
   (let ((cd (cdr (assoc root *cad-demos*)))
 	(*highlight-ink* (if (color-stream-p root) +red+ +flipping-ink+)))
     (when (or (null cd) reinit)
-      (setq cd (make-application-frame 'cad-demo :parent root))
-      (push (cons root cd) *cad-demos*)
-      ;; The application implements its own output history
-      (let ((dp (get-frame-pane cd 'design-area)))
-	;;--- kludge this one pane
-	(setf (stream-output-history dp) cd)
-	(setf (stream-recording-p dp) nil)))
-    (catch 'exit-cad-demo
-      (run-frame-top-level cd))))
+      (setq cd (make-application-frame 'cad-demo
+				       :width 700 :height 600))
+      (push (cons root cd) *cad-demos*))
+    (run-frame-top-level cd)))
 
 (define-demo "Mini-CAD" (run-cad-demo :root *demo-root*))
diff --git a/demo/demo-driver.lisp b/demo/demo-driver.lisp
index bcac7ac2..6eee8ab8 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: aaai-demo-driver.lisp,v 1.3 92/02/26 10:23:54 cer Exp $
+;; $fiHeader: aaai-demo-driver.lisp,v 1.4 92/03/04 16:22:56 cer Exp $
 
 (in-package :clim-demo)
 
@@ -47,6 +47,8 @@
     (lisp:format t "~&No current value for *DEMO-ROOT*.  Use what value? ")
     (setq root (eval (lisp:read)))
     (setq *demo-root* root))
+  #+Silica
+  (unless root (setq root (find-graft)))
   (labels ((demo-menu-drawer (stream type &rest args)
 	     (declare (dynamic-extent args))
 	     (with-text-style (stream '(:serif :roman :very-large))
@@ -72,6 +74,6 @@
 (defparameter *color-stream-p* t)
 (defun color-stream-p (stream)
   #-Genera *color-stream-p*		;--- kludge
-  #+Genera (if (eql (port-type (port stream)) ':genera)
+  #+Genera (if (eql (silica:port-type (port stream)) ':genera)
 	       (slot-value stream 'clim-internals::color-p)
 	       *color-stream-p*))
diff --git a/demo/demo-prefill.lisp b/demo/demo-prefill.lisp
index 9fa286ef..f9d2ac99 100644
--- a/demo/demo-prefill.lisp
+++ b/demo/demo-prefill.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: demo-prefill.lisp,v 1.1 92/01/31 14:32:00 cer Exp $
+;; $fiHeader: demo-prefill.lisp,v 1.2 92/02/24 13:09:22 cer Exp $
 
 (in-package :clim-internals)
 
@@ -132,7 +132,7 @@
 		      (CLIM-DEMO::LISP-LISTENER T)) 
   (MAP-OVER-OUTPUT-RECORDS-OVERLAPPING-REGION
     (T CLIM-DEMO::CAD-DEMO T)) 
-  (MAP-OVER-OUTPUT-RECORDS-CONTAINING-POINT*
+  (MAP-OVER-OUTPUT-RECORDS-CONTAINING-POSITION
     (T CLIM-DEMO::CAD-DEMO T T)) 
   (READ-FRAME-COMMAND (CLIM-DEMO::GRAPHICS-DEMO) 
 		      (CLIM-DEMO::FLIGHT-PLANNER) 
diff --git a/demo/graphics-demos.lisp b/demo/graphics-demos.lisp
index 58050a22..51adc4a2 100644
--- a/demo/graphics-demos.lisp
+++ b/demo/graphics-demos.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graphics-demos.lisp,v 1.2 92/02/24 13:09:23 cer Exp Locker: cer $
+;; $fiHeader: graphics-demos.lisp,v 1.3 92/04/10 14:27:31 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
@@ -29,7 +29,7 @@
 		  (make-pane 'application-pane)))
 	  (explanation (scrolling ()
 		         (make-pane 'application-pane
-				       :height 100))))
+				    :height 100))))
   (:layout (:default
 	      (vertically () demo explanation))))
 
diff --git a/demo/listener.lisp b/demo/listener.lisp
index 2bc27dd7..94b52a02 100644
--- a/demo/listener.lisp
+++ b/demo/listener.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: listener.lisp,v 1.7 92/03/10 10:13:08 cer Exp Locker: cer $
+;; $fiHeader: listener.lisp,v 1.8 92/04/10 14:27:32 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
@@ -119,7 +119,7 @@
       (when (eq type :keystroke)
 	(let ((command (lookup-keystroke-command-item command-or-form command-table 
 						      :numeric-argument numeric-arg)))
-	  (unless (clim-internals::keyboard-gesture-p command)
+	  (unless (clim-internals::keyboard-event-p command)
 	    (when (partial-command-p command)
 	      (setq command (funcall *partial-command-parser*
 				     command command-table *standard-input* nil
@@ -333,15 +333,16 @@
     (formatting-table (stream :x-spacing "   ")
       (dolist (pathname pathnames)
 	(let (size creation-date author)
-	  #-genera
+	  #-Genera
 	  (with-open-file (file-stream pathname :direction :input) 
 	    (setf size (file-length file-stream)
 		  creation-date (file-write-date file-stream)
 		  author (file-author file-stream)))
-	  #+genera
+	  #+Genera
 	  (setf size (getf (rest pathname) :length-in-bytes)
 		creation-date (getf (rest pathname) :modification-date)
-		author (getf (rest pathname) :author))
+		author (getf (rest pathname) :author)
+		pathname (first pathname))
 	  (with-output-as-presentation (stream pathname 'pathname
 					:single-box t)
 	    (formatting-row (stream)
diff --git a/demo/navfun.lisp b/demo/navfun.lisp
index afad4f82..e65578ae 100644
--- a/demo/navfun.lisp
+++ b/demo/navfun.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: navfun.lisp,v 1.4 92/04/10 14:27:34 cer Exp Locker: cer $
+;; $fiHeader: navfun.lisp,v 1.5 92/04/14 15:30:01 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
@@ -43,6 +43,9 @@
 (defvar *label-text-style* #+Genera '(:fix :roman :small)
 			   #-Genera '(:fix :roman :normal))
 
+(defclass iconic-view (gadget-view) ())
+(defvar +iconic-view+ (make-instance 'iconic-view))
+
 
 ;;; Basic data structures - points and positions
 
@@ -220,11 +223,11 @@
   (draw-coastline *coastline*)
   (flet ((present-position (object)
 	   (present object (class-name (class-of object))
-		    :view +gadget-view+ :single-box t)))
+		    :view +iconic-view+ :single-box t)))
     (mapc #'present-position *position-list*))
   (flet ((present-route (object)
 	   (present object (class-name (class-of object))
-		    :view +gadget-view+ :single-box nil)))
+		    :view +iconic-view+ :single-box nil)))
     (mapc #'present-route *route-list*)
     (mapc #'present-route *victor-airway-list*)))
 
@@ -313,8 +316,8 @@
 (eval-when (compile load eval)
   (defclass named-intersection (named-position) ()))
 
-(defmethod draw-position ((named-intersection named-intersection) stream &optional label)
-  (with-slots (longitude latitude) named-intersection
+(defmethod draw-position ((intersection named-intersection) stream &optional label)
+  (with-slots (longitude latitude) intersection
     (multiple-value-bind (x y) (scale-coordinates longitude latitude)
       (rounding-coordinates (x y)
 	(let ((color-args (and (color-stream-p stream)
@@ -343,7 +346,7 @@
 
 (define-presentation-type ground-position ())
 
-(define-presentation-method present (object (type ground-position) stream (view gadget-view) &key)
+(define-presentation-method present (object (type ground-position) stream (view iconic-view) &key)
   (draw-position object stream))
 
 
@@ -354,7 +357,7 @@
   (let ((*print-object-readably* acceptably))
     (format stream "~A" (position-name object))))
 
-(define-presentation-method present (object (type named-position) stream (view gadget-view)
+(define-presentation-method present (object (type named-position) stream (view iconic-view)
 				     &key)
   (draw-position object stream
 		 (and (typep object 'named-position)
@@ -494,7 +497,7 @@
   (let ((*print-object-readably* acceptably))
     (format stream "~A" (route-name object))))
 
-(define-presentation-method present (object (type route) stream (view gadget-view) &key)
+(define-presentation-method present (object (type route) stream (view iconic-view) &key)
   (let ((drawing-args (if (color-stream-p stream)
 			  (list :ink +red+)
 			  '(:line-dashes t))))
@@ -522,7 +525,7 @@
   (let ((*print-object-readably* acceptably))
     (format stream "~A" (route-name object))))
 
-(define-presentation-method present (object (type victor-airway) stream (view gadget-view)
+(define-presentation-method present (object (type victor-airway) stream (view iconic-view)
 				     &key)
   (let ((drawing-args (if (color-stream-p stream)
 			  (list :ink +blue+)
@@ -1010,25 +1013,24 @@
     (multiple-value-bind (x y)
 	(scale-coordinates longitude latitude)
     (with-bounding-rectangle* (left top right bottom) (window-viewport window)
-      (window-set-viewport-position* window
-				     (max 0 (- (floor x) (floor (- right left) 2)))
-				     (max 0 (- (floor y) (floor (- bottom top) 2))))))))
+      (window-set-viewport-position window
+				    (max 0 (- (floor x) (floor (- right left) 2)))
+				    (max 0 (- (floor y) (floor (- bottom top) 2))))))))
 
 
 ;;; Flight-Planner user interface
 
 (define-application-frame Flight-Planner
-    ()
-  ((fp-window))
+			  ()
+    ((fp-window))
   (:panes 
-   (display (make-pane 'application-pane))
-   (interactor (make-pane 'interactor-pane)))
+    (display (make-pane 'application-pane))
+    (interactor (make-pane 'interactor-pane)))
   (:layout 
-   (default
-       (vertically 
-	()
-	(scrolling () display)
-	(scrolling () interactor)))))
+    (default
+      (vertically ()
+ 	(scrolling () display)
+ 	(scrolling () interactor)))))
 
 (define-Flight-Planner-command (com-Zoom-In :name t :menu t) ()
   (multiple-value-bind (longitude latitude)
@@ -1119,17 +1121,17 @@
     (ground-position
       (let ((new-position (query-new-position)))
 	(when new-position
-	  (present new-position 'ground-position :view +gadget-view+)
+	  (present new-position 'ground-position :view +iconic-view+)
 	  (push new-position *position-list*))))
     (route
       (let* ((new-route (query-new-route :route-start route-start)))
 	(when new-route
-	  (present new-route 'route :view +gadget-view+)
+	  (present new-route 'route :view +iconic-view+)
 	  (push new-route *route-list*))))
     (victor-airway
       (let ((new-victor-airway (query-new-victor-airway)))
 	(when new-victor-airway
-	  (present new-victor-airway 'victor-airway :view +gadget-view+)
+	  (present new-victor-airway 'victor-airway :view +iconic-view+)
 	  (push new-victor-airway *victor-airway-list*))))
     (aircraft
       (let ((new-aircraft (query-new-aircraft)))
@@ -1601,13 +1603,18 @@
 
 (defun customize-database ()
   ;; Airports
-  (add-position "HFD" 'airport (degminsec 41 44) (degminsec 72 39) 19  15 "Hartford-Brainard")
+  (add-position "HFD" 'airport
+		(degminsec 41 44) (degminsec 72 39) 19  15 "Hartford-Brainard")
  
-  ;; Named-Intersections
-  (add-position "DREEM" 'named-intersection (degminsec 42 21.6) (degminsec 71 44.3) 0 15 "DREEM")
-  (add-position "GRAYM" 'named-intersection (degminsec 42 06.1) (degminsec 72 01.9) 0 15 "GRAYM")
-  (add-position "WITNY" 'named-intersection (degminsec 42 03) (degminsec 72 14.2) 0 15 "WITNY")
-  (add-position "EAGRE" 'named-intersection (degminsec 41 45) (degminsec 72 20.6) 0 15 "EAGRE")
+  ;; Intersections
+  (add-position "DREEM" 'named-intersection
+		(degminsec 42 21.6) (degminsec 71 44.3) 0 15 "DREEM")
+  (add-position "GRAYM" 'named-intersection
+		(degminsec 42 06.1) (degminsec 72 01.9) 0 15 "GRAYM")
+  (add-position "WITNY" 'named-intersection
+		(degminsec 42 03) (degminsec 72 14.2) 0 15 "WITNY")
+  (add-position "EAGRE" 'named-intersection
+		(degminsec 41 45) (degminsec 72 20.6) 0 15 "EAGRE")
 
   ;; VOR's
 
@@ -1649,7 +1656,8 @@
 (defun run-flight-planner (&key reinit root)
   (let ((fp (cdr (assoc root *flight-planners*))))
     (when (or (null fp) reinit)
-      (setq fp (make-application-frame 'flight-planner :parent root))
+      (setq fp (make-application-frame 'flight-planner
+				       :width 1000 :height 800))
       (push (cons root fp) *flight-planners*))
     (run-frame-top-level fp)))
 
diff --git a/demo/puzzle.lisp b/demo/puzzle.lisp
index 48963154..955706b6 100644
--- a/demo/puzzle.lisp
+++ b/demo/puzzle.lisp
@@ -1,28 +1,28 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: puzzle.lisp,v 1.3 92/03/24 19:38:21 cer Exp Locker: cer $
+;; $fiHeader: puzzle.lisp,v 1.4 92/04/10 14:27:36 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
 "Copyright (c) 1989, 1990, 1991 Symbolics, Inc.  All rights reserved."
 
 (define-application-frame puzzle 
-    ()
-  ((puzzle :initform (make-array '(4 4))
-	   :accessor puzzle-puzzle))
+			  ()
+    ((puzzle :initform (make-array '(4 4))
+	     :accessor puzzle-puzzle))
   (:panes
-   (display
-    (outlining ()
-	       (make-pane 'application-pane
-			     :text-cursor nil
-			     :width :compute
-			     :max-width +fill+
-			     :height :compute
-			     :max-height +fill+
-			     :incremental-redisplay T
-			     :display-function 'draw-puzzle))))
+    (display
+      (outlining ()
+        (make-pane 'application-pane
+		   :text-cursor nil
+		   :width :compute
+		   :max-width +fill+
+		   :height :compute
+		   :max-height +fill+
+		   :incremental-redisplay T
+		   :display-function 'draw-puzzle))))
   (:layout
-   (:default display)))
+    (:default display)))
 
 (defmethod frame-query-io ((puzzle puzzle))
   (get-frame-pane puzzle 'display))
@@ -71,26 +71,27 @@
 
 (defmethod draw-puzzle ((puzzle puzzle) stream &key max-width max-height)
   (declare (ignore max-width max-height))
-  (with-text-style (stream  '(:fix :bold :very-large))
-   (with-end-of-page-action (stream :allow)
+  (with-text-style (stream '(:fix :bold :very-large))
+    (with-end-of-page-action (stream :allow)
       (with-end-of-line-action (stream :allow)
-    (let ((puzzle-array (puzzle-puzzle puzzle)))
-      ;; I'm not sure why the table sometimes draws in the wrong place if I don't do this
-      (stream-set-cursor-position* stream 0 0)
-      (updating-output (stream)
-	(formatting-table (stream)
-	  (dotimes (row 4)
-	    (formatting-row (stream)
-	      (dotimes (column 4)
-		(let ((value (aref puzzle-array row column)))
-		  (updating-output (stream
-				     :unique-id (encode-puzzle-cell row column)
-				     :cache-value value)
-		    (formatting-cell (stream :align-x :right)
-		      (unless (zerop value)
-			(with-output-as-presentation 
-			    (stream (encode-puzzle-cell row column) 'puzzle-cell)
-			  (format stream "~2D" value))))))))))))))))
+	(let ((puzzle-array (puzzle-puzzle puzzle)))
+	  ;; I'm not sure why the table sometimes draws in the wrong place if I don't do this
+	  (stream-set-cursor-position stream 0 0)
+	  (updating-output (stream)
+	    (formatting-table (stream)
+	      (dotimes (row 4)
+		(formatting-row (stream)
+		  (dotimes (column 4)
+		    (let ((value (aref puzzle-array row column)))
+		      (updating-output (stream
+					 :unique-id (encode-puzzle-cell row column)
+					 :cache-value value)
+			(formatting-cell (stream :align-x :right)
+			  (unless (zerop value)
+			    (with-output-as-presentation 
+				(stream (encode-puzzle-cell row column) 'puzzle-cell)
+			      (format stream "~D" value))))))))))))))))
+
 
 (defun find-open-cell (puzzle)
   (dotimes (row 4)
diff --git a/demo/sysdcl.lisp b/demo/sysdcl.lisp
index 86e622da..6aca3296 100644
--- a/demo/sysdcl.lisp
+++ b/demo/sysdcl.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: sysdcl.lisp,v 1.6 92/03/24 19:38:22 cer Exp Locker: cer $
+;; $fiHeader: sysdcl.lisp,v 1.7 92/04/10 14:27:37 cer Exp Locker: cer $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user)
 
@@ -22,26 +22,23 @@
 			    #+Allegro (frob-pathname "demo")
 			    #+CMU "/home/hornig/clim/rel-2/cmu/"
 			    #+CCL-2 "ccl;clim-2.0:fasls:"
-;;;; :needed-systems (clim-standalone)
-			    )
+   ;;--- :needed-systems (clim-standalone)
+   )
 
   ("packages")
   ("aaai-demo-driver" :load-before-compile ("packages"))
   ("listener"       :load-before-compile ("aaai-demo-driver" "packages"))
   ("graphics-demos" :load-before-compile ("aaai-demo-driver" "packages")
 		    :features (not Minima))
-  ("puzzle"         :load-before-compile ("aaai-demo-driver" "packages"))
   ("cad-demo"	    :load-before-compile ("aaai-demo-driver" "packages")
 		    :features (not Minima))
   ("navdata"	    :load-before-compile ("packages")
 		    :features (not Minima))
   ("navfun"         :load-before-compile ("aaai-demo-driver" "navdata" "packages")
 		    :features (not Minima))
-  ("address-book"   :load-before-compile ("aaai-demo-driver"
-					  "packages"))
-  ("thinkadot"      :load-before-compile ("aaai-demo-driver"
-					  "packages"))
-  
+  ("puzzle"         :load-before-compile ("aaai-demo-driver" "packages"))
+  ("address-book"   :load-before-compile ("aaai-demo-driver" "packages"))
+  ("thinkadot"      :load-before-compile ("aaai-demo-driver" "packages"))
   ("demo-prefill" :features (and (not Silica) (or Genera Cloe-Runtime))))
 
 #+Genera
diff --git a/demo/thinkadot.lisp b/demo/thinkadot.lisp
index b8eb5e92..2d5e1b43 100644
--- a/demo/thinkadot.lisp
+++ b/demo/thinkadot.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: thinkadot.lisp,v 1.4 92/03/24 19:38:23 cer Exp Locker: cer $
+;; $fiHeader: thinkadot.lisp,v 1.5 92/04/10 14:27:38 cer Exp Locker: cer $
 
 (in-package :clim-demo)
 
@@ -39,24 +39,24 @@
 
 
 (define-application-frame thinkadot ()
-  ((node1)
-   (node2)
-   (node3)
-   (node4)
-   (node5)
-   (node6)
-   (node7)
-   (node8)
-   (all-nodes)
-   (lexit)
-   (rexit))
+    ((node1)
+     (node2)
+     (node3)
+     (node4)
+     (node5)
+     (node6)
+     (node7)
+     (node8)
+     (all-nodes)
+     (lexit)
+     (rexit))
   (:panes
-   (display
-    (make-pane 'application-pane
-		  :display-function 'draw-the-display
-		  :incremental-redisplay t)))
+    (display
+      (make-pane 'application-pane
+		 :display-function 'draw-the-display
+		 :incremental-redisplay t)))
   (:layout
-   (:default (scrolling () display))))
+    (:default (scrolling () display))))
 
 (defmethod initialize-instance :after ((frame thinkadot) &key)
   (multiple-value-bind (w h)
@@ -90,7 +90,6 @@
 (defvar *light-color* (make-gray-color 0.667))
 (defvar *dark-color* +black+)
 
-
 (defmethod draw-the-display ((frame thinkadot) stream &key max-width max-height)
   (declare (ignore max-width max-height))
   (with-slots (all-nodes lexit rexit) frame
@@ -143,7 +142,7 @@
 
 (define-presentation-to-command-translator drop-a-marble
     (entry-node com-drop-marble thinkadot
-		:documentation "Drop Marble")
+     :documentation "Drop a Marble")
     (object)
   `(,object))
 
diff --git a/genera/genera-activities.lisp b/genera/genera-activities.lisp
index 0afa976e..6f6fb5a6 100644
--- a/genera/genera-activities.lisp
+++ b/genera/genera-activities.lisp
@@ -1,12 +1,11 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: genera-activities.lisp,v 1.1 92/02/24 13:28:00 cer Exp $
+;; $fiHeader: genera-activities.lisp,v 1.3 92/03/10 10:13:06 cer Exp $
 
 (in-package :genera-clim)
 
-
 "Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved."
-;;; $fiHeader: genera-activities.lisp,v 1.1 92/02/24 13:28:00 cer Exp $
+
 
 (defvar *sheet-roots* nil)
 (defvar *deactivated-clim-activities* nil)
diff --git a/genera/genera-frames.lisp b/genera/genera-frames.lisp
index f9036dbb..75e16d37 100644
--- a/genera/genera-frames.lisp
+++ b/genera/genera-frames.lisp
@@ -1,9 +1,9 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*-
+;; $fiHeader: genera-frames.lisp,v 1.2 92/03/04 16:22:45 cer Exp $
 
 (in-package :genera-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved."
-;;; $fiHeader: genera-frames.lisp,v 1.2 92/03/04 16:22:45 cer Exp Locker: cer $
 
 (defclass genera-frame-manager (standard-frame-manager)
     ())
@@ -19,9 +19,9 @@
 	  (vertically ()
 	    (outlining ()
 	      (make-pane 'command-menu-pane
-			    :display-function 
-			      `(display-command-menu :command-table ,menu-bar)
-			    :width :compute :height :compute))
+			 :display-function 
+			   `(display-command-menu :command-table ,menu-bar)
+			 :width :compute :height :compute))
 	    pane))
 	pane)))
 
diff --git a/genera/genera-gadgets.lisp b/genera/genera-gadgets.lisp
index adefbd06..8584bad1 100644
--- a/genera/genera-gadgets.lisp
+++ b/genera/genera-gadgets.lisp
@@ -1,9 +1,10 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: genera-gadgets.lisp,v 1.2 92/03/04 16:22:47 cer Exp $
+
 (in-package :genera-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved."
-;;; $fiHeader: genera-gadgets.lisp,v 1.2 92/03/04 16:22:47 cer Exp Locker: cer $
 
 (defmethod make-pane-class ((framem genera-frame-manager) class &rest options)
   (declare (ignore options))
@@ -31,17 +32,18 @@
 			 ))))
 
 (defmethod make-pane-1 ((framem genera-frame-manager)
-			   frame abstract-type &rest options)
+			frame abstract-type &rest options)
   (let ((type (apply #'make-pane-class framem abstract-type options)))
     (if type
 	(apply #'make-instance type
 	       :frame frame
 	       :frame-manager framem
-	       (apply #'make-pane-arglist
-		      framem abstract-type options))
+	       (apply #'make-pane-arglist framem abstract-type options))
 	(call-next-method))))
 
 (defmethod make-pane-arglist (realizer type &rest options)
   (declare (ignore realizer type))
   options)
 
+;;--- This isn't really right.
+(defmethod sheet-shell (sheet) sheet)
diff --git a/genera/genera-medium.lisp b/genera/genera-medium.lisp
index 245808ba..3b344e83 100644
--- a/genera/genera-medium.lisp
+++ b/genera/genera-medium.lisp
@@ -1,9 +1,11 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: genera-medium.lisp,v 1.2 92/03/04 16:22:49 cer Exp $
+
 (in-package :genera-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved."
-;;; $fiHeader: genera-medium.lisp,v 1.1 92/02/24 13:28:05 cer Exp $
+
 
 (defclass genera-medium (medium)
     ((window :initform nil)
@@ -403,7 +405,7 @@
 		      (eq region +nowhere+))	;---yow! howcum?
 		  (kernel window)
 		(with-bounding-rectangle* (left top right bottom) region
-		  (integerize-coordinates left top right bottom)
+		  (fix-coordinates left top right bottom)
 		  (with-stack-list (cr (+ (tv:sheet-left-margin-size window) left)
 				       (+ (tv:sheet-top-margin-size window) top)
 				       (+ (tv:sheet-right-margin-size window) right)
@@ -821,8 +823,8 @@
 	  (height (if (<= target-y source-y) (+ height) (- height))))
       (tv:bitblt-from-sheet-to-sheet
 	boole (round width) (round height)	;--- round???
-	source-drawable (integerize-coordinate source-x) (integerize-coordinate source-y)
-	target-drawable (integerize-coordinate target-x) (integerize-coordinate target-y)))))
+	source-drawable (fix-coordinate source-x) (fix-coordinate source-y)
+	target-drawable (fix-coordinate target-x) (fix-coordinate target-y)))))
 
 ;;; X also has a way to copy from a medium into a pixmap.  Should this be allowed here?
 (defmethod copy-area ((pixmap pixmap) dst-x dst-y 
@@ -839,6 +841,7 @@
 	     (raster (realize-pixmap port pixmap)))
 	(scl:send drawable :bitblt-from-sheet boole
 		  (round device-width) (round device-height)	;--- round???
-		  (integerize-coordinate device-min-x) (integerize-coordinate device-min-y)
-		  raster (integerize-coordinate dst-x) (integerize-coordinate dst-y))))))
+		  (fix-coordinate device-min-x) (fix-coordinate device-min-y)
+		  raster 
+		  (fix-coordinate dst-x) (fix-coordinate dst-y))))))
 ||#
diff --git a/genera/genera-mirror.lisp b/genera/genera-mirror.lisp
index 1ffd81de..42141a2d 100644
--- a/genera/genera-mirror.lisp
+++ b/genera/genera-mirror.lisp
@@ -1,10 +1,11 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: genera-mirror.lisp,v 1.2 92/03/04 16:22:50 cer Exp $
+
 (in-package :genera-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved.
  Portions copyright (c) 1991, 1992 International Lisp Associates."
-;;; $fiHeader: genera-mirror.lisp,v 1.1 92/02/24 13:28:07 cer Exp $
 
 
 (defvar *clim-window-count* 0)
@@ -14,7 +15,7 @@
   (with-slots (screen height-pixels) port
     (multiple-value-bind (left top right bottom)
 	(sheet-native-region* sheet)
-      (integerize-coordinates left top right bottom)
+      (fix-coordinates left top right bottom)
       (let* ((genera-parent (sheet-mirror sheet))
 	     (name (format nil "CLIM window ~D" (incf *clim-window-count*)))
 	     (mirror
@@ -157,10 +158,8 @@
       (multiple-value-bind (left top right bottom)
 	  (fit-region*-in-region* left top right bottom
 				  clip-left clip-top clip-right clip-bottom)
-	(scl:send mirror :set-edges (integerize-coordinate left)
-				    (integerize-coordinate top)
-				    (integerize-coordinate right)
-				    (integerize-coordinate bottom))))))
+	(scl:send mirror :set-edges (fix-coordinate left)  (fix-coordinate top)
+				    (fix-coordinate right) (fix-coordinate bottom))))))
 
 
 ;; Port trigger not nil means that the port is triggering the
diff --git a/genera/genera-port.lisp b/genera/genera-port.lisp
index 5de613ba..c51a4b31 100644
--- a/genera/genera-port.lisp
+++ b/genera/genera-port.lisp
@@ -1,9 +1,10 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: genera-port.lisp,v 1.2 92/03/04 16:22:52 cer Exp $
+
 (in-package :genera-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved.
-;;; $fiHeader: genera-port.lisp,v 1.2 92/03/04 16:22:52 cer Exp Locker: cer $
  Portions copyright (c) 1991, 1992 International Lisp Associates."
 
 
@@ -384,7 +385,7 @@
       (cons real-genera-keysym shifts))))
 
 ;; The standard characters
-(define-genera-keysym #\Space :Space)
+(define-genera-keysym #\Space :space)
 (define-genera-keysym #\! :\!)
 (define-genera-keysym #\" :\")
 (define-genera-keysym #\# :\#)
@@ -418,31 +419,57 @@
 (define-genera-keysym #\? :\?)
 (define-genera-keysym #\@ :\@)
 (define-genera-keysym #\A :\A)
+(define-genera-keysym #\a :\A)
 (define-genera-keysym #\B :\B)
+(define-genera-keysym #\b :\B)
 (define-genera-keysym #\C :\C)
+(define-genera-keysym #\c :\C)
 (define-genera-keysym #\D :\D)
+(define-genera-keysym #\d :\D)
 (define-genera-keysym #\E :\E)
+(define-genera-keysym #\e :\E)
 (define-genera-keysym #\F :\F)
+(define-genera-keysym #\f :\F)
 (define-genera-keysym #\G :\G)
+(define-genera-keysym #\g :\G)
 (define-genera-keysym #\H :\H)
+(define-genera-keysym #\h :\H)
 (define-genera-keysym #\I :\I)
+(define-genera-keysym #\i :\I)
 (define-genera-keysym #\J :\J)
+(define-genera-keysym #\j :\J)
 (define-genera-keysym #\K :\K)
+(define-genera-keysym #\k :\K)
 (define-genera-keysym #\L :\L)
+(define-genera-keysym #\l :\L)
 (define-genera-keysym #\M :\M)
+(define-genera-keysym #\m :\M)
 (define-genera-keysym #\N :\N)
+(define-genera-keysym #\n :\N)
 (define-genera-keysym #\O :\O)
+(define-genera-keysym #\o :\O)
 (define-genera-keysym #\P :\P)
+(define-genera-keysym #\p :\P)
 (define-genera-keysym #\Q :\Q)
+(define-genera-keysym #\q :\Q)
 (define-genera-keysym #\R :\R)
+(define-genera-keysym #\r :\R)
 (define-genera-keysym #\S :\S)
+(define-genera-keysym #\s :\S)
 (define-genera-keysym #\T :\T)
+(define-genera-keysym #\t :\T)
 (define-genera-keysym #\U :\U)
+(define-genera-keysym #\u :\U)
 (define-genera-keysym #\V :\V)
+(define-genera-keysym #\v :\V)
 (define-genera-keysym #\W :\W)
+(define-genera-keysym #\w :\W)
 (define-genera-keysym #\X :\X)
+(define-genera-keysym #\x :\X)
 (define-genera-keysym #\Y :\Y)
+(define-genera-keysym #\y :\Y)
 (define-genera-keysym #\Z :\Z)
+(define-genera-keysym #\z :\Z)
 (define-genera-keysym #\[ :\[)
 (define-genera-keysym #\\ :\\)
 (define-genera-keysym #\] :\])
@@ -516,7 +543,7 @@
 	(let ((transformation (sheet-native-transformation stream)))
 	  (multiple-value-bind (x y) (bounding-rectangle* cursor)
 	    (multiple-value-setq (x y)
-	      (transform-point* transformation x y))
+	      (transform-position transformation x y))
 	    (cond ((and active state focus)
 		   (scl:send mirror :set-cursorpos x y)
 		   (scl:send blinker :set-visibility :blink))
diff --git a/misc/dev-load-1.lisp b/misc/dev-load-1.lisp
index a4075e1d..c0a77598 100644
--- a/misc/dev-load-1.lisp
+++ b/misc/dev-load-1.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: dev-load-1.lisp,v 1.1 92/03/24 19:45:42 cer Exp Locker: cer $
+;; $fiHeader: dev-load-1.lisp,v 1.2 92/04/10 14:27:45 cer Exp Locker: cer $
 
 (excl::free (excl::malloc 131072))
 
@@ -55,12 +55,15 @@
   
   (compile-file-if-needed "test/test-suite")
 
-  (tenuring
-   (load "test/test-suite") )
+  (let ((*load-source-file-info* t)
+	(*load-xref-info* nil))
 
-  (load "demo/sysdcl")
-  (tenuring
-   (clim-defsys::load-system 'clim-demo))
+    (tenuring
+     (load "test/test-suite") )
+
+    (load "demo/sysdcl")
+    (tenuring
+     (clim-defsys::load-system 'clim-demo)))
   
   (when (probe-file "/scm/4.1/sparc/src/code/")
     (let ((sys::*require-search-list*
diff --git a/pre-silica/cloe-implementation.lisp b/pre-silica/cloe-implementation.lisp
index e6967b46..f29b0848 100644
--- a/pre-silica/cloe-implementation.lisp
+++ b/pre-silica/cloe-implementation.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cloe-implementation.lisp,v 1.2 92/02/24 13:07:01 cer Exp $
+;; $fiHeader: cloe-implementation.lisp,v 1.3 92/03/10 10:12:16 cer Exp $
 
 (in-package :clim-internals)
 
@@ -588,16 +588,14 @@
 			 (round (+ (* (cos end-angle) x-radius) center-x))
 			 (round (+ (* (sin end-angle) y-radius) center-y))
 			 (round (+ (* (cos start-angle) x-radius) center-x))
-			 (round (+ (* (sin start-angle) y-radius) center-y))
-	
-			 ))
+			 (round (+ (* (sin start-angle) y-radius) center-y))))
 	      (t
 	       ;; drawing an arc
 	       (win::arc window left top right bottom
-			 (+ (* (cos start-angle) x-radius) center-x)
-			 (+ (* (sin start-angle) y-radius) center-y)
-			 (+ (* (cos end-angle) x-radius) center-x)
-			 (+ (* (sin end-angle) y-radius) center-y))))))))
+			 (round (+ (* (cos end-angle) x-radius) center-x))
+			 (round (+ (* (sin end-angle) y-radius) center-y))
+			 (round (+ (* (cos start-angle) x-radius) center-x))
+			 (round (+ (* (sin start-angle) y-radius) center-y)))))))))
 
 
 
diff --git a/pre-silica/clx-implementation.lisp b/pre-silica/clx-implementation.lisp
index 658bbb75..cc00fc1b 100644
--- a/pre-silica/clx-implementation.lisp
+++ b/pre-silica/clx-implementation.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clx-implementation.lisp,v 1.3 92/03/04 16:21:10 cer Exp $
+;; $fiHeader: clx-implementation.lisp,v 1.4 92/03/10 10:12:18 cer Exp $
 
 (in-package :clim-internals)
 
@@ -439,7 +439,7 @@
 		 (multiple-value-bind (x y same-screen-p child mask root-x root-y root)
 		     (xlib:query-pointer root-window)
 		   (declare (ignore x y same-screen-p child mask root))
-		   (pointer-set-position* pointer root-x root-y)
+		   (pointer-set-position pointer root-x root-y)
 		   (setf (pointer-window pointer) ws)
 		   (setf (pointer-motion-pending ws pointer) t))
 		 (return-from event-loop :mouse-motion))
@@ -456,7 +456,6 @@
 		   (setf (pointer-window pointer) ws)
 		   ;; Resolve the selected-window issue.  We currently just put the
 		   ;; button-press "blip" in the clicked-on window's input buffer.
-		   ;; X and Y are presumed to be fixnums here
 		   (case event-key
 		     (:button-press
 		       (stream-note-pointer-button-press
@@ -645,21 +644,21 @@
   (and *clx-use-color*
        (> (xlib:screen-root-depth (clx-stream-screen stream)) 2)))
 
-(defparameter *clx-scrollbar-border-width* 0)
-(defparameter *clx-scrollbar-width* 14)
+(defparameter *clx-scroll-bar-border-width* 0)
+(defparameter *clx-scroll-bar-width* 14)
 
-;;--- Scrollbars have an inner margin
+;;--- Scroll-Bars have an inner margin
 ;;--- Perhaps we should use window-margin!
-(defvar *clx-scrollbar-inner-margin* 2)
+(defvar *clx-scroll-bar-inner-margin* 2)
 
-(defclass clx-scrollbar (clx-window) 
+(defclass clx-scroll-bar (clx-window) 
     ((scroll-bar-values-1 :initform nil
 			  :accessor scroll-bar-values-1)
      (scroll-bar-values-2 :initform nil
 			  :accessor scroll-bar-values-2)))
 
-(defclass clx-h-scrollbar (clx-scrollbar) ())
-(defclass clx-v-scrollbar (clx-scrollbar) ())
+(defclass clx-h-scroll-bar (clx-scroll-bar) ())
+(defclass clx-v-scroll-bar (clx-scroll-bar) ())
 
 (defmethod initialize-instance :before ((stream clx-window) &key parent)
   (setf (slot-value stream 'display-device-type)
@@ -763,7 +762,7 @@
   (when scroll-bars
     ;; Adjust right and bottom for the border of the window
     (multiple-value-bind (lom tom rom bom) (host-window-margins stream)
-      (declare (fixnum rom bom) (ignore lom tom))
+      (declare (type coordinate rom bom) (ignore lom tom))
       (decf right rom)
       (decf bottom bom))
     (with-slots (horizontal-scroll-bar vertical-scroll-bar) stream
@@ -772,11 +771,11 @@
 	(when hp
 	  (setf horizontal-scroll-bar 
 		(open-window-stream :parent stream 
-				    :window-class 'clx-h-scrollbar
+				    :window-class 'clx-h-scroll-bar
 				    :borders nil
-				    :left (if vp *clx-scrollbar-width* 0) 
+				    :left (if vp *clx-scroll-bar-width* 0) 
 				    :right right
-				    :top (- bottom top *clx-scrollbar-width*) 
+				    :top (- bottom top *clx-scroll-bar-width*) 
 				    :bottom (- bottom top)
 				    :scroll-bars nil))
 	  (setf (stream-recording-p horizontal-scroll-bar) nil)
@@ -785,11 +784,11 @@
 	  (setf vertical-scroll-bar
 		(open-window-stream :parent stream 
 				    :borders nil
-				    :window-class 'clx-v-scrollbar
+				    :window-class 'clx-v-scroll-bar
 				    :left 0 
-				    :right *clx-scrollbar-width*
+				    :right *clx-scroll-bar-width*
 				    :top 0
-				    :bottom (- bottom top (if hp *clx-scrollbar-width* 0))
+				    :bottom (- bottom top (if hp *clx-scroll-bar-width* 0))
 				    :scroll-bars nil))
 	  (setf (stream-recording-p vertical-scroll-bar) nil)
 	  (window-expose vertical-scroll-bar))))))
@@ -797,11 +796,11 @@
 
 ;;; Scroll bars
 
-(defmethod stream-replay ((stream clx-scrollbar) &optional region)
+(defmethod stream-replay ((stream clx-scroll-bar) &optional region)
   (declare (ignore region))
-  (draw-scrollbar stream t))
+  (draw-scroll-bar stream t))
 
-(defmethod stream-note-pointer-button-press ((bar clx-v-scrollbar)
+(defmethod stream-note-pointer-button-press ((bar clx-v-scroll-bar)
 					     pointer button modifier-state x y)
   (declare (ignore pointer modifier-state x))
   (let* ((stream (window-parent bar))
@@ -811,14 +810,14 @@
 	(declare (ignore hleft hright))
 	(with-bounding-rectangle* (v-left v-top v-right v-bottom) (window-viewport stream)
 	  (declare (ignore v-right))
-	  (window-set-viewport-position* stream 
+	  (window-set-viewport-position stream 
 	    v-left
 	    (compute-scroll-to-value
 	      y (bounding-rectangle-width bar) (bounding-rectangle-height bar)
 	      htop hbottom v-top v-bottom button))
-	  (draw-scrollbar bar))))))
+	  (draw-scroll-bar bar))))))
 
-(defmethod stream-note-pointer-button-press ((bar clx-h-scrollbar)
+(defmethod stream-note-pointer-button-press ((bar clx-h-scroll-bar)
 					     pointer button modifier-state x y)
   (declare (ignore pointer modifier-state y))
   (let* ((stream (window-parent bar))
@@ -828,12 +827,12 @@
 	(declare (ignore htop hbottom))
 	(with-bounding-rectangle* (v-left v-top v-right v-bottom) (window-viewport stream)
 	  (declare (ignore v-bottom))
-	  (window-set-viewport-position* stream 
+	  (window-set-viewport-position stream 
 	    (compute-scroll-to-value
 	      x (bounding-rectangle-height bar) (bounding-rectangle-width bar)
 	      hleft hright v-left v-right button)
 	    v-top)
-	  (draw-scrollbar bar))))))
+	  (draw-scroll-bar bar))))))
 
 (defun compute-scroll-to-value (y bar-width bar-height
 				history-top history-bottom viewport-top viewport-bottom
@@ -863,7 +862,7 @@
 	      (scroll-bar-values-2 stream) slug-length)
        ,@body)))
 
-(defmethod draw-scrollbar ((stream clx-v-scrollbar) &optional force-p)
+(defmethod draw-scroll-bar ((stream clx-v-scroll-bar) &optional force-p)
   (with-bounding-rectangle* (left top right bottom) stream
     (let ((width (- right left))
 	  (height (- bottom top))
@@ -875,8 +874,8 @@
 				  (window-viewport win)
 	  (declare (ignore viewport-left viewport-right))
 	  (multiple-value-bind (y1 y2 y3 y4 x1 x2 slug-start slug-length)
-	      (compute-scrollbar-values
-		height width *clx-scrollbar-inner-margin*
+	      (compute-scroll-bar-values
+		height width *clx-scroll-bar-inner-margin*
 		extent-top extent-bottom viewport-top viewport-bottom)
 	    (with-scroll-bar-update 
 	      (if (or force-p (null old-slug-start))
@@ -899,7 +898,7 @@
 		(1+ x1) slug-start (1- x2) (+ slug-start slug-length)
 		:ink +light-gray+))))))))
 
-(defmethod draw-scrollbar ((stream clx-h-scrollbar) &optional force-p)
+(defmethod draw-scroll-bar ((stream clx-h-scroll-bar) &optional force-p)
   (with-bounding-rectangle* (left top right bottom) stream
     ;; The -1 adjusts for X unfilled rectangles being one pixel too big.  jdi
     (let ((width (- right left 1))
@@ -912,8 +911,8 @@
 				  (window-viewport win)
 	  (declare (ignore viewport-top viewport-bottom))
 	  (multiple-value-bind (x1 x2 x3 x4 y1 y2 slug-start slug-length)
-	      (compute-scrollbar-values
-		width height *clx-scrollbar-inner-margin*
+	      (compute-scroll-bar-values
+		width height *clx-scroll-bar-inner-margin*
 		extent-left extent-right viewport-left viewport-right)
 	    (with-scroll-bar-update 
 	      (if (or force-p (null old-slug-start))
@@ -936,7 +935,7 @@
 		slug-start (1+ y1) (+ slug-start slug-length) (1- y2)
 		:ink +light-gray+))))))))
  
-(defun compute-scrollbar-values (long short margin
+(defun compute-scroll-bar-values (long short margin
 				 extent-min extent-max viewport-min viewport-max)
   (let* ((square (- short (* 2 margin)))
 	 (x1 margin)
@@ -956,30 +955,30 @@
       (values x1 x2 x3 x4 y1 y2 (floor slug-start) (floor slug-length))))
 
 ;; Update the scroll-bars when their parent window changes
-(defun update-scrollbars (stream width height)
+(defun update-scroll-bars (stream width height)
   ;; Adjust width and height for the border of the window
   (multiple-value-bind (lom tom rom bom) (host-window-margins stream)
-    (declare (fixnum lom tom rom bom))
+    (declare (type coordinate lom tom rom bom))
     (decf width (+ lom rom))
     (decf height (+ tom bom)))
   (with-slots (horizontal-scroll-bar vertical-scroll-bar) stream
     (when vertical-scroll-bar
       (let ((new-height
-	     (if horizontal-scroll-bar (- height *clx-scrollbar-width*) height)))
+	     (if horizontal-scroll-bar (- height *clx-scroll-bar-width*) height)))
 	(when (/= new-height (bounding-rectangle-height vertical-scroll-bar))
 	  (bounding-rectangle-set-size 
 	   vertical-scroll-bar
 	   (bounding-rectangle-width vertical-scroll-bar)
 	   new-height)
-	  (draw-scrollbar vertical-scroll-bar t))))
+	  (draw-scroll-bar vertical-scroll-bar t))))
     (when horizontal-scroll-bar
       (bounding-rectangle-set-edges
 	horizontal-scroll-bar
-	(if vertical-scroll-bar *clx-scrollbar-width* 0)
-	(- height *clx-scrollbar-width*)
+	(if vertical-scroll-bar *clx-scroll-bar-width* 0)
+	(- height *clx-scroll-bar-width*)
 	width
 	height)
-      (draw-scrollbar horizontal-scroll-bar))))
+      (draw-scroll-bar horizontal-scroll-bar))))
 
 (defmethod host-window-margins ((stream clx-window))
   (let* ((parent (window-parent stream)))
@@ -1002,17 +1001,17 @@
   (let ((h (window-horizontal-scroll-bar stream))
 	(v (window-vertical-scroll-bar stream)))
     (values (if v 
-		(+ (* 2 *clx-scrollbar-border-width*) (bounding-rectangle-width v))
+		(+ (* 2 *clx-scroll-bar-border-width*) (bounding-rectangle-width v))
 	        0)
 	    0 
 	    0
 	    (if h
-		(+ (* 2 *clx-scrollbar-border-width*) (bounding-rectangle-height h))
+		(+ (* 2 *clx-scroll-bar-border-width*) (bounding-rectangle-height h))
 	        0))))
 
 (defmethod window-note-size-or-position-change :after
 	   ((stream clx-window) new-left new-top new-right new-bottom)
-  (update-scrollbars stream (- new-right new-left) (- new-bottom new-top)))
+  (update-scroll-bars stream (- new-right new-left) (- new-bottom new-top)))
 
 
 (defmethod (setf medium-foreground) :after (ink (stream clx-window))
@@ -1142,12 +1141,12 @@
 (defmethod invoke-with-clipping-region
 	   ((stream clx-window) continuation (region standard-bounding-rectangle))
   (with-slots (window clip-mask) stream
-    (multiple-value-bind (x y) (window-viewport-position* stream)
+    (multiple-value-bind (x y) (window-viewport-position stream)
       (declare (type coordinate x y))
       (multiple-value-bind (ml mt) (window-margins stream)
 	(declare (type coordinate ml mt))
       	(with-bounding-rectangle* (left top right bottom) region
-	  (translate-fixnum-positions (- ml x) (- mt y)
+	  (translate-coordinates (- ml x) (- mt y)
 	    left top right bottom)
 	  (fix-points left top right bottom)
 	  ;;--- How not to cons? (this list and the rectangles)
@@ -1246,7 +1245,7 @@
   (let ((width (- right left))
 	(height (- bottom top)))
     (multiple-value-bind (lom tom rom bom) (host-window-margins stream)
-      (declare (fixnum lom tom rom bom))
+      (declare (type coordinate lom tom rom bom))
       (let ((x-width (- width lom rom))
 	    (x-height (- height tom bom)))
 	(assert (plusp x-width) (x-width)
@@ -1259,12 +1258,12 @@
 		  (xlib:drawable-y window) top
 		  (xlib:drawable-width window) x-width
 		  (xlib:drawable-height window) x-height)))))
-    (update-scrollbars stream width height))
+    (update-scroll-bars stream width height))
   (clx-force-output-if-necessary stream t))
 
 (defmethod bounding-rectangle-set-size :after ((stream clx-window) width height)
   (multiple-value-bind (lom tom rom bom) (host-window-margins stream)
-    (declare (fixnum lom tom rom bom))
+    (declare (type coordinate lom tom rom bom))
     (with-slots (window) stream
       (let ((x-width (- width lom rom))
 	    (x-height (- height tom bom)))
@@ -1275,10 +1274,10 @@
 	(xlib:with-state (window)
 	  (setf (xlib:drawable-width window) x-width
 		(xlib:drawable-height window) x-height)))))
-  (update-scrollbars stream width height)
+  (update-scroll-bars stream width height)
   (clx-force-output-if-necessary stream t))
 
-(defmethod bounding-rectangle-set-position* :after ((stream clx-window) new-left new-top)
+(defmethod bounding-rectangle-set-position :after ((stream clx-window) new-left new-top)
   (with-slots (window) stream
     (xlib:with-state (window)
       (setf (xlib:drawable-x window) new-left)
@@ -1288,9 +1287,9 @@
 (defmethod redisplay-decorations ((stream clx-window))
   (with-slots (horizontal-scroll-bar vertical-scroll-bar) stream
     (when vertical-scroll-bar
-      (draw-scrollbar vertical-scroll-bar))
+      (draw-scroll-bar vertical-scroll-bar))
     (when horizontal-scroll-bar
-      (draw-scrollbar horizontal-scroll-bar))))
+      (draw-scroll-bar horizontal-scroll-bar))))
 
 
 
@@ -1708,11 +1707,12 @@
 (defmethod draw-polygon-internal ((stream clx-window) x-offset y-offset
 				  list-of-x-and-ys closed ink line-style)
   (setq list-of-x-and-ys
-	(mapcar #'round (translate-point-sequence x-offset y-offset list-of-x-and-ys)))
+	(mapcar #'round 
+		(translate-position-sequence x-offset y-offset list-of-x-and-ys)))
   (let ((minx most-positive-fixnum)
 	(miny most-positive-fixnum)
 	(points list-of-x-and-ys))
-    (declare (fixnum minx miny))
+    (declare (type fixnum minx miny))
     (do* ((points list-of-x-and-ys (cddr points))
 	  (x (car points) (car points))
 	  (y (cadr points) (cadr points)))
diff --git a/pre-silica/default-application.lisp b/pre-silica/default-application.lisp
index 1d230f34..a5116d2c 100644
--- a/pre-silica/default-application.lisp
+++ b/pre-silica/default-application.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: default-application.lisp,v 1.3 92/03/04 16:21:23 cer Exp $
+;; $fiHeader: default-application.lisp,v 1.4 92/03/10 10:12:25 cer Exp $
 
 (in-package :clim-internals)
 
@@ -27,7 +27,7 @@
     #+Allegro
     (when (and *click-outside-menu-handler*
 		(output-recording-stream-p window)
-		(not (region-contains-point*-p (stream-output-history window) x y)))
+		(not (region-contains-position-p (stream-output-history window) x y)))
       (funcall *click-outside-menu-handler*))
     (when highlighted-presentation
       ;; Unhighlight on the way out.
@@ -109,7 +109,7 @@
 (defun frame-document-highlighted-presentation-1
        (frame presentation input-context window x y stream)
   (let ((modifier-state (window-modifier-state window)))
-    (declare (fixnum modifier-state))
+    (declare (type fixnum modifier-state))
     (multiple-value-bind (left   left-presentation   left-context
 			  middle middle-presentation middle-context
 			  right  right-presentation  right-context)
@@ -126,7 +126,7 @@
 		 ;; Assumes 5 modifier keys and the reverse ordering of *MODIFIER-KEYS*
 		 (let ((bit #o20)
 		       (shift-name '("h-" "s-" "m-" "c-" "sh-")))
-		   (declare (fixnum bit))
+		   (declare (type fixnum bit))
 		   (dotimes (i 5)
 		     #-(or Allegro Minima) (declare (ignore i))
 		     (unless (zerop (logand bit modifier-state))
diff --git a/pre-silica/defs-graphics-generics.lisp b/pre-silica/defs-graphics-generics.lisp
index e2155300..975cf8e1 100644
--- a/pre-silica/defs-graphics-generics.lisp
+++ b/pre-silica/defs-graphics-generics.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: defs-graphics-generics.lisp,v 1.2 92/02/24 13:07:23 cer Exp $
+;; $fiHeader: defs-graphics-generics.lisp,v 1.3 92/03/04 16:21:28 cer Exp $
 
 (in-package :clim-internals)
 
@@ -93,43 +93,43 @@
 		    forms))
 	  (values)))
 
-(defmacro transform-points ((transform) &rest points)
-  (when points
-    (assert (evenp (length points)) ()
-	    "Points must be x/y pairs.  There are an odd number of elements in ~S"
-	    points)
+(defmacro transform-positions ((transform) &rest positions)
+  (when positions
+    (assert (evenp (length positions)) ()
+	    "Positions must be x/y pairs.  There are an odd number of elements in ~S"
+	    positions)
     (let ((xform '#:transform))
       `(let ((,xform ,transform))
-	 ,@(do* ((points points (cddr points))
-		 (x (first points) (first points))
-		 (y (second points) (second points))
+	 ,@(do* ((positions positions (cddr positions))
+		 (x (first positions) (first positions))
+		 (y (second positions) (second positions))
 		 (forms nil))
-		((null points) (nreverse forms))
+		((null positions) (nreverse forms))
 	     (push `(multiple-value-setq (,x ,y)
-		      (transform-point* ,xform ,x ,y))
+		      (transform-position ,xform ,x ,y))
 		   forms))
 	 (values)))))
 
-;;; Update the points list in the reference.
-(defmacro transform-point-sequence ((transform) points-reference)
-  (let ((pts-sequence '#:points-sequence)
-	(pts-temp '#:points)
-	(original-pts-temp '#:original-points)
+;;; Update the positions list in the reference.
+(defmacro transform-position-sequence ((transform) positions-reference)
+  (let ((pts-sequence '#:position-sequence)
+	(pts-temp '#:positions)
+	(original-pts-temp '#:original-positions)
 	(xform '#:transform))
     ;;--- is a run-time error check worth it?
-    `(let ((,pts-sequence ,points-reference)
+    `(let ((,pts-sequence ,positions-reference)
 	   (,xform ,transform))
        (assert (evenp (length ,pts-sequence)) ()
-	       "Points must be x/y pairs.  There are an odd number of elements in ~S"
+	       "Positions must be x/y pairs.  There are an odd number of elements in ~S"
 	       ,pts-sequence)
-       (setf ,points-reference
+       (setf ,positions-reference
 	     (let* ((,pts-temp (copy-list ,pts-sequence))
 		    (,original-pts-temp ,pts-temp))
 	       (dorest (pt ,pts-sequence cddr)
 		 (let ((x (first pt))
 		       (y (second pt)))
 		   (multiple-value-bind (nx ny)
-		       (transform-point* ,xform x y)
+		       (transform-position ,xform x y)
 		     (setf (car ,pts-temp) nx
 			   ,pts-temp (cdr ,pts-temp)
 			   (car ,pts-temp) ny
@@ -194,20 +194,20 @@
 	  (assert (evenp (length (rest spec))) ()
 		  "Points must be listed in x/y pairs. ~S has an odd number of elements."
 		  (rest spec))
-	  (push `(transform-points (,transform) ,@(rest spec))
+	  (push `(transform-positions (,transform) ,@(rest spec))
 		clauses))
 	(rectangle
 	  ;; The rest of the spec if a list of left/top/right/bottom 4-tuples.
 	  (assert (zerop (mod (length (rest spec)) 4)) ()
 		  "Rectangles must have four values, left top right bottom.  ~S"
 		  (rest spec))
-	  (push `(transform-points (,transform) ,@(rest spec))
+	  (push `(transform-positions (,transform) ,@(rest spec))
 		clauses))
 	(point-sequence
 	  ;; Elements of REST are references containing lists of points.
 	  (dolist (ps (rest spec))
 	    ;; No compile-time ASSERTion.
-	    (push `(transform-point-sequence (,transform) ,ps)
+	    (push `(transform-position-sequence (,transform) ,ps)
 		  clauses)))
 	(distance
 	  ;; The rest of the spec is a list of dx/dy pairs indicating a distance
@@ -239,7 +239,7 @@
 	   (,sy 0))
        (when ,array
 	 (multiple-value-bind (,vx ,vy)
-	     (window-viewport-position* ,stream)
+	     (window-viewport-position ,stream)
 	   (multiple-value-bind (,sw ,sh)
 	       (values-list (array-dimensions ,array))
 	     (translate-positions (mod ,vx ,sw) (mod ,vy ,sh) ,sx ,sy))))
@@ -293,7 +293,7 @@
 	(when (stream-recording-p stream)
 	  ,output-recording-hook
 	  (multiple-value-bind (abs-x abs-y)
-	      (point-position*
+	      (point-position
 		(stream-output-history-position stream))
 	    (declare (type coordinate abs-x abs-y))
 	    ;; Adjust the coordinates by the position of the current record
@@ -305,9 +305,9 @@
 		  rec
 		  (- lf abs-x) (- tp abs-y)
 		  (- rt abs-x) (- bt abs-y)))
-	      (multiple-value-bind (cx cy) (stream-cursor-position* stream)
+	      (multiple-value-bind (cx cy) (stream-cursor-position stream)
 		(declare (type coordinate cx cy))
-		;; Doing this directly beats calling OUTPUT-RECORD-SET-START-CURSOR-POSITION*
+		;; Doing this directly beats calling OUTPUT-RECORD-SET-START-CURSOR-POSITION
 		(with-slots (start-x start-y) rec
 		  (setq start-x (- cx abs-x)
 			start-y (- cy abs-y)))
@@ -318,8 +318,8 @@
 		,@(when point-sequence-to-convert
 		    `((with-slots (,point-sequence-to-convert) rec
 			(setq ,point-sequence-to-convert
-			      (ntranslate-point-sequence (- abs-x) (- abs-y)
-							 ,point-sequence-to-convert))))))
+			      (ntranslate-position-sequence (- abs-x) (- abs-y)
+							    ,point-sequence-to-convert))))))
 	      (stream-add-output-record stream rec))))
 	(when (stream-drawing-p stream)
 	  (call-next-method)))
diff --git a/pre-silica/genera-implementation.lisp b/pre-silica/genera-implementation.lisp
index 361d7651..076df200 100644
--- a/pre-silica/genera-implementation.lisp
+++ b/pre-silica/genera-implementation.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: genera-implementation.lisp,v 1.2 92/02/24 13:07:36 cer Exp $
+;; $fiHeader: genera-implementation.lisp,v 1.3 92/03/04 16:21:40 cer Exp $
 
 (in-package :clim-internals)
 
@@ -100,7 +100,7 @@
 	  (translate-positions wl wt left top right bottom))))
     (scl:send window :set-edges left top right bottom)))
 
-(defmethod bounding-rectangle-set-position* :after
+(defmethod bounding-rectangle-set-position :after
 	   ((stream sheet-implementation-mixin) new-left new-top)
   (with-slots (window) stream
     (let ((superior (tv:sheet-superior window)))
@@ -201,7 +201,7 @@
   (with-slots (update-region) stream
     (when update-region
       (multiple-value-bind (vx vy)
-	  (window-viewport-position* stream)
+	  (window-viewport-position stream)
 	(dolist (rectangle update-region)
 	  (with-bounding-rectangle* (left top right bottom) rectangle
 	    (translate-positions (- vx) (- vy) left top right bottom)
@@ -1120,7 +1120,7 @@
 	(with-bounding-rectangle* (hleft htop hright hbottom) history
 	  (declare (ignore hleft hright))
 	  (setq top (min (max htop top) hbottom))))
-      (window-set-viewport-position* stream left top))))
+      (window-set-viewport-position stream left top))))
 
 (scl:defmethod (:x-scroll-to clim-sheet) (position type)
   (let* ((stream (sheet-for-genera-window scl:self))
@@ -1131,7 +1131,7 @@
 	(with-bounding-rectangle* (hleft htop hright hbottom) history
 	  (declare (ignore htop hbottom))
 	  (setq left (min (max left hleft) hright))))
-      (window-set-viewport-position* stream left top))))
+      (window-set-viewport-position stream left top))))
 
 ;;; The window manager should manipulate the highest "CLIM sheet" when invoked
 ;;; on an inferior.
@@ -1197,7 +1197,7 @@
   (let ((window (sheet-for-genera-window scl:self)))
     (setf (slot-value window 'highlighted-presentation) nil)
     (multiple-value-bind (viewport-x viewport-y)
-	(bounding-rectangle-position* (window-viewport window))
+	(bounding-rectangle-position (window-viewport window))
       (frame-replay *application-frame*
 		    window (make-bounding-rectangle (+ left viewport-x)
 						    (+ top viewport-y)
@@ -1407,7 +1407,7 @@
 (defmethod invoke-with-clipping-region
 	   ((stream sheet-implementation-mixin) continuation (region standard-bounding-rectangle))
   (let ((window (slot-value stream 'window)))
-    (multiple-value-bind (vx vy) (window-viewport-position* stream)
+    (multiple-value-bind (vx vy) (window-viewport-position stream)
       (declare (type coordinate vx vy))
       (multiple-value-bind (ml mt) (window-margins stream)
 	(declare (type coordinate ml mt))
@@ -1453,7 +1453,7 @@
     (setf (pointer-window pointer)
 	  (sheet-for-genera-window (tv:window-under-mouse-internal mouse)
 				       :error-if-no-match nil))
-    (pointer-set-position* pointer (tv:mouse-x mouse) (tv:mouse-y mouse))))
+    (pointer-set-position pointer (tv:mouse-x mouse) (tv:mouse-y mouse))))
 
 (defmethod stream-event-handler ((stream sheet-window-stream)
 				 &key (timeout nil) (input-wait-test nil))
@@ -1531,7 +1531,6 @@
 			   (let ((pw (sheet-for-genera-window mouse-window)))
 			     (setf (pointer-window pointer) pw)
 			     (multiple-value-bind (xm ym) (scl:send mouse-window :margins)
-			       ;; X and Y are presumed to be fixnums here
 			       (stream-note-pointer-button-press
 				 pw pointer (ash 1 (si:mouse-char-button char))
 				 (mouse-char-bits->modifier-state (si:mouse-char-bits char))
@@ -1539,7 +1538,7 @@
 		    (t (queue-put (stream-input-buffer stream) character)))))
 	  (:mouse-motion
 	    ;; ---
-	    (pointer-set-position* pointer (mouse-x) (mouse-y))
+	    (pointer-set-position pointer (mouse-x) (mouse-y))
 	    (let ((window (sheet-for-genera-window (tv:window-under-mouse-internal mouse)
 						       :error-if-no-match nil)))
 	      (setf (pointer-window pointer) window)
@@ -1557,7 +1556,7 @@
 (defmethod stream-pointer-input-rectangle* ((stream sheet-window-stream) pointer
 					    &key left top right bottom)
   (declare (ignore pointer))
-  (multiple-value-bind (dx dy) (window-viewport-position* stream)
+  (multiple-value-bind (dx dy) (window-viewport-position stream)
     (setq left (if (typep left 'real) (round left) dx))
     (setq top  (if (typep top  'real) (round top) dy))
     (setq right  (if (typep right  'real) (round right) (+ left 50)))
@@ -1815,11 +1814,11 @@
   new-value)
 
 #-Silica
-(defmethod cursor-position* ((cursor sheet-text-cursor))
+(defmethod cursor-position ((cursor sheet-text-cursor))
   (values (slot-value cursor 'x) (slot-value cursor 'y)))
 
 #-Silica
-(defmethod cursor-set-position* ((cursor sheet-text-cursor) x y)
+(defmethod cursor-set-position ((cursor sheet-text-cursor) x y)
   (setf (slot-value cursor 'x) x
 	(slot-value cursor 'y) y)
   (let ((blinker (slot-value cursor 'blinker)))
diff --git a/pre-silica/graphics-internals.lisp b/pre-silica/graphics-internals.lisp
index 68cf403a..1662bd96 100644
--- a/pre-silica/graphics-internals.lisp
+++ b/pre-silica/graphics-internals.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graphics-internals.lisp,v 1.1 92/01/31 14:27:56 cer Exp $
+;; $fiHeader: graphics-internals.lisp,v 1.2 92/02/24 13:07:44 cer Exp $
 
 (in-package :clim-internals)
 
@@ -33,7 +33,7 @@
 	   ((record output-record-mixin) x-offset y-offset)
   (let ((designs nil))
     (flet ((make-design (record)
-	     (multiple-value-bind (xoff yoff) (output-record-position* record)
+	     (multiple-value-bind (xoff yoff) (output-record-position record)
 	       (declare (type coordinate xoff yoff))
 	       (let ((design
 		       (make-design-from-output-record-1
@@ -57,7 +57,7 @@
 (defmethod draw-design ((point standard-point) stream &rest args &key ink line-style)
   (declare (dynamic-extent args)
 	   (ignore ink line-style))
-  (multiple-value-bind (x y) (point-position* point)
+  (multiple-value-bind (x y) (point-position point)
     (apply #'draw-point* stream x y args)))
 
 
@@ -142,8 +142,6 @@
      (with-slots (x1 y1 x2 y2 line-style) record
        (or (null line-style)
 	   (with-half-thickness (lthickness rthickness) line-style
-	     ;; Don't use LTRB-CONTAINS-POINT*-P, since that expects fixnums
-	     ;;---- Not any more!
 	     (not (and (<= (+ x1 rthickness) x)
 		       (<= (+ y1 rthickness) y)
 		       (>= (- x2 lthickness) x)
@@ -205,7 +203,7 @@
 	   ((polygon polygon-displayed-output-record) x-offset y-offset)
   (with-slots (list-of-xs-and-ys closed line-style ink) polygon
     (let ((coords (copy-list list-of-xs-and-ys)))
-      (translate-point-sequence x-offset y-offset coords)
+      (translate-position-sequence x-offset y-offset coords)
       (compose-in
 	ink
 	(if (null line-style)
diff --git a/pre-silica/postscript-implementation.lisp b/pre-silica/postscript-implementation.lisp
index 712009d1..f800589e 100644
--- a/pre-silica/postscript-implementation.lisp
+++ b/pre-silica/postscript-implementation.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: postscript-implementation.lisp,v 1.1 92/01/31 14:28:01 cer Exp $
+;; $fiHeader: postscript-implementation.lisp,v 1.2 92/02/24 13:08:11 cer Exp $
 
 (in-package :clim-internals)
 
@@ -90,14 +90,15 @@
 ;;; This structure is used to represent a PostScript font masquerading as a
 ;;; CLIM-world entity.  They populate the font-map array of the stream.
 (defstruct (ps-font-compat-kludge (:conc-name psfck-))
-  index						;index into stream's array.
-  style-descriptor				;parse-text-style output.
-  true-ps-descriptor				;("Times" :italic 6 [pts])
-  points					;point-size
-  clim-height					;equivalent size in CLIM "pixels"
-  clim-ascent					;top-to-baseline, "pixels"
-  clim-descent					;baseline-to-bottom
-  width-table)					;width array or constant #.
+  index					;index into stream's array.
+  style-descriptor			;parse-text-style output.
+  true-ps-descriptor			;("Times" :italic 6 [pts])
+  points				;point-size
+  clim-height				;equivalent size in CLIM "pixels"
+  clim-ascent				;top-to-baseline, "pixels"
+  clim-descent				;baseline-to-bottom
+  width-table				;width array or constant #.
+  (established nil))			;T ==> written to the printer
 
 ;;; Each element is ((family face) width-or-width-table-array height ascent descent)
 (defvar *char-width-tables* nil)
@@ -262,6 +263,7 @@
       (header-comments :initform nil :initarg :header-comments)
       (orientation :initform :portrait :initarg :orientation)
       ;; For multi-page output, analogous to a window's scroll position
+      (multi-page :initform nil :initarg :multi-page)
       (viewport-x :initform 0)
       (viewport-y :initform 0)))
 
@@ -546,15 +548,24 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
 
 (defmethod postscript-prologue ((stream postscript-implementation-mixin))
   (with-slots (printer-stream header-comments display-device-type orientation) stream
-    (format printer-stream "%! nonconforming~%")
-    (format printer-stream "%%Creator: CLIM 1.0~%")
+    (format printer-stream "%!PS-Adobe-2.0 EPSF-2.0~%")
+    (multiple-value-bind (left top right bottom)
+	(postscript-bounding-box-edges stream)
+      (format printer-stream "%%BoundingBox: ~D ~D ~D ~D~%"
+	left top right bottom))
+    (format printer-stream "%%Creator: CLIM 2.0~%")
     (let ((title (getf header-comments :title)))
       (when title
         (format printer-stream "%%Title: ~A~%" title)))
     (let ((for (or (getf header-comments :for) #+Genera zl:user-id)))
       (when for
         (format printer-stream "%%For: ~A~%" for)))
-    #+Genera (format printer-stream "%%CreationDate: ~\\date\\~%" (get-universal-time))
+    (multiple-value-bind (second minute hour date month year)
+	(decode-universal-time (get-universal-time))
+      (format printer-stream "%%CreationDate: ~D-~A-~D ~2,'0D:~2,'0D:~2,'0D~%"
+	date (svref #("Jan" "Feb" "Mar" "Apr" "May" "Jun"
+		      "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") month) year
+	hour minute second))
     (format printer-stream "%%DocumentFonts: (atend)~%")
     (format printer-stream "%%EndComments~%")
     (write-string *postscript-prologue* printer-stream)
@@ -570,7 +581,7 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
     (format printer-stream
         "/new-matrix {0 format-y-translation translate
 		      format-rotation rotate} def
-	 /new-page {showpage new-matrix} def")
+	 /new-page {showpage new-matrix} def~%")
     (format printer-stream "%%EndProlog~%")
     (format printer-stream "~%new-matrix~%")))
 
@@ -969,21 +980,27 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
   (format printer-stream ") show~%"))
 
 (defmethod get-font-compat-str ((stream postscript-implementation-mixin) text-style)
-  (with-slots (font-map printer-stream) stream 
-    (let ((styledesc (parse-text-style text-style))
-	  (al (length font-map)))
-      (do ((i 0 (1+ i)))
-	  ((>= i al)
-	   (error "Font map overflow for ~S" stream))
-	(let ((fcs (aref font-map i)))
-	  (when (null fcs)
-	    (setq fcs (make-new-fcs styledesc i))
-	    (setf (aref font-map i) fcs)
-	    (format printer-stream "~D ~D /~A estfont~%" 
-	      (psfck-index fcs) (psfck-points fcs) (get-ps-fam-face-name fcs))
-	    (return fcs))
-	  (when (eq styledesc (psfck-style-descriptor fcs))
-	    (return fcs)))))))
+  (with-slots (font-map printer-stream draw-p) stream 
+    (let* ((styledesc (parse-text-style text-style))
+	   (al (length font-map))
+	   (fcs
+	     (do ((i 0 (1+ i)))
+		 ((>= i al)
+		  (error "Font map overflow for ~S" stream))
+	       (let ((fcs (aref font-map i)))
+		 (when (null fcs)
+		   (setq fcs (make-new-fcs styledesc i))
+		   (setf (aref font-map i) fcs)
+		   (return fcs))
+		 (when (eq styledesc (psfck-style-descriptor fcs))
+		   (return fcs))))))
+      (when (and fcs 
+		 draw-p
+		 (not (psfck-established fcs)))
+	(format printer-stream "~D ~D /~A estfont~%"
+	  (psfck-index fcs) (psfck-points fcs) (get-ps-fam-face-name fcs))
+	(setf (psfck-established fcs) t))
+      fcs)))
 
 
 ;; PostScript's "default user space" is measured in printers' points.
@@ -1094,15 +1111,19 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
   (:default-initargs :display-device-type *postscript-device*
 		     :default-text-margin 1000))
 
-(defmethod initialize-instance :after ((stream postscript-stream) &key)
-  (postscript-prologue stream))
-
 (defun make-postscript-stream (stream)
   (make-instance 'postscript-stream :stream stream))
 
 (defmethod close ((stream postscript-stream) &key abort)
-  (declare (ignore abort))
-  (postscript-epilogue stream))
+  (unless abort
+    (postscript-epilogue stream)))
+
+(defmethod postscript-bounding-box-edges ((stream postscript-stream))
+  (with-bounding-rectangle* (left top right bottom)
+      (stream-output-history stream)
+    (pixels-to-points left top right bottom)
+    (values (round left) (round top)
+	    (round right) (round bottom))))
 
 (defmethod window-inside-width ((stream postscript-implementation-mixin))
   (with-slots (display-device-type) stream
@@ -1129,39 +1150,39 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
 ;; Replay some PostScript output, breaking it into multiple pages
 (defmethod stream-replay ((stream postscript-implementation-mixin) &optional region)
   (with-slots (output-record record-p draw-p display-device-type 
-	       printer-stream orientation viewport-x viewport-y) stream
+	       printer-stream orientation multi-page viewport-x viewport-y) stream
     (when draw-p
       (when output-record
 	(letf-globally ((record-p nil))
-	  (if region 
+	  (if (or region (not multi-page))
 	      (replay output-record stream region)
-	    (with-bounding-rectangle* (left top right bottom) output-record
-	      (let* ((page-width
-		       (floor (* (slot-value display-device-type 'page-width)
-				 (slot-value display-device-type 'device-units-per-inch))
-			      *1-pixel=points*))
-		     (page-height
-		       (floor (* (slot-value display-device-type 'page-height)
-				 (slot-value display-device-type 'device-units-per-inch))
-			      *1-pixel=points*))
-		     (first-page t))
-		(setq viewport-x 0 viewport-y 0)
-		;; Draw each chunk of output on its own page
-		(unwind-protect
-		    (do ((y top (+ y page-height)))
-			((> y bottom))
-		      (do ((x left (+ x page-width)))
-			  ((> x right))
-			(if first-page
-			    (setq first-page nil)
-			    (format printer-stream "new-page~%"))
-			(let ((region (make-bounding-rectangle
-					x y (+ x page-width) (+ y page-height))))
-			  (replay output-record stream region))
-			(incf viewport-x page-width))
-		      (setf viewport-x 0)
-		      (incf viewport-y page-height))
-		(setq viewport-x 0 viewport-y 0))))))))))
+	      (with-bounding-rectangle* (left top right bottom) output-record
+		(let* ((page-width
+			 (floor (* (slot-value display-device-type 'page-width)
+				   (slot-value display-device-type 'device-units-per-inch))
+				*1-pixel=points*))
+		       (page-height
+			 (floor (* (slot-value display-device-type 'page-height)
+				   (slot-value display-device-type 'device-units-per-inch))
+				*1-pixel=points*))
+		       (first-page t))
+		  (setq viewport-x 0 viewport-y 0)
+		  ;; Draw each chunk of output on its own page
+		  (unwind-protect
+		      (do ((y top (+ y page-height)))
+			  ((> y bottom))
+			(do ((x left (+ x page-width)))
+			    ((> x right))
+			  (if first-page
+			      (setq first-page nil)
+			      (format printer-stream "gsave new-page grestore~%"))
+			  (let ((region (make-bounding-rectangle
+					  x y (+ x page-width) (+ y page-height))))
+			    (replay output-record stream region))
+			  (incf viewport-x page-width))
+			(setf viewport-x 0)
+			(incf viewport-y page-height))
+		    (setq viewport-x 0 viewport-y 0))))))))))
 		
 
 (defmacro with-output-to-postscript-stream ((stream-var file-stream &rest args) &body body)
@@ -1184,17 +1205,17 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
 					  :stream file-stream
 					  :display-device-type display-device
 					  :header-comments header-comments
-					  :orientation orientation))
+					  :orientation orientation
+					  :multi-page multi-page))
 	(abort-p t))
-    (with-output-recording-options (postscript-stream :record t :draw (not multi-page))
+    (with-output-recording-options (postscript-stream :record t :draw nil)
       (unwind-protect
 	  (multiple-value-prog1
 	    (funcall continuation postscript-stream)
-	    (when multi-page
-	      ;; In the case of multi-page output, we have not actually output
-	      ;; anything to the printer yet.  Do so now, breaking the output
-	      ;; up into multiple pages.
-	      (with-output-recording-options (postscript-stream :record nil :draw t)
-		(frame-replay *application-frame* postscript-stream)))
+	    (postscript-prologue postscript-stream)
+	    ;; Now do the output to the printer, breaking up the output into
+	    ;; multiple pages if that was requested
+	    (with-output-recording-options (postscript-stream :record nil :draw t)
+	      (frame-replay *application-frame* postscript-stream))
 	    (setq abort-p nil))
 	(close postscript-stream :abort abort-p)))))
diff --git a/pre-silica/protocol-intermediaries.lisp b/pre-silica/protocol-intermediaries.lisp
index d4fb65e4..dd4786e7 100644
--- a/pre-silica/protocol-intermediaries.lisp
+++ b/pre-silica/protocol-intermediaries.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: protocol-intermediaries.lisp,v 1.1 92/01/31 14:28:04 cer Exp $
+;; $fiHeader: protocol-intermediaries.lisp,v 1.2 92/02/24 13:08:20 cer Exp $
 
 (in-package :clim-internals)
 
@@ -18,29 +18,29 @@
   (multiple-value-bind (nx ny) (viewport-to-drawing-surface-coordinates window x y)
     (call-next-method window pointer button modifier-state nx ny)))
 
-(defmethod stream-pointer-position* :around ((window input-and-window-protocol-intermediary)
-					     &rest args)
+(defmethod stream-pointer-position :around ((window input-and-window-protocol-intermediary)
+					    &rest args)
   (declare (ignore args))
   (multiple-value-bind (x y)
       (call-next-method)
     (viewport-to-drawing-surface-coordinates window x y)))
 
-(defmethod stream-set-pointer-position* :around
+(defmethod stream-set-pointer-position :around
   ((window input-and-window-protocol-intermediary) x y &key pointer)
   (multiple-value-bind (nx ny) (viewport-to-drawing-surface-coordinates window x y)
     (call-next-method window nx ny :pointer pointer)))
 
-(defmethod stream-set-cursor-position* :after ((window input-and-window-protocol-intermediary)
-					       x y)
+(defmethod stream-set-cursor-position :after ((window input-and-window-protocol-intermediary)
+					      x y)
   (let ((cursor (stream-text-cursor window)))
     (when cursor
-      (cursor-set-position* cursor x y))))
+      (cursor-set-position cursor x y))))
 
-(defmethod stream-set-cursor-position*-internal :after
+(defmethod stream-set-cursor-position-internal :after
 	   ((window input-and-window-protocol-intermediary) x y)
   (let ((cursor (stream-text-cursor window)))
     (when cursor
-      (cursor-set-position* cursor x y))))
+      (cursor-set-position cursor x y))))
 
 
 ;;; Methods for streams that are both windows and extended output streams
@@ -89,10 +89,10 @@
 			(not draw)
 			(not (stream-recording-p stream)))))
     (multiple-value-bind (old-x old-y)
-	(when restore-p (stream-cursor-position* stream))
+	(when restore-p (stream-cursor-position stream))
       (unwind-protect
 	  (progn
 	    (stream-close-text-output-record stream)
 	    (call-next-method stream continuation record draw))
-	(when restore-p (stream-set-cursor-position* stream old-x old-y))))))
+	(when restore-p (stream-set-cursor-position stream old-x old-y))))))
 
diff --git a/pre-silica/window-protocol.lisp b/pre-silica/window-protocol.lisp
index 86abafa0..1cb9d95c 100644
--- a/pre-silica/window-protocol.lisp
+++ b/pre-silica/window-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: window-protocol.lisp,v 1.3 92/02/24 13:08:54 cer Exp $
+;; $fiHeader: window-protocol.lisp,v 1.4 92/03/04 16:22:28 cer Exp $
 
 (in-package :clim-internals)
 
@@ -78,7 +78,7 @@
   (let ((*synchronous-window-operation-being-processed* T))
     (call-next-method)))
 
-(defmethod bounding-rectangle-set-position* :around ((window window-mixin) nx ny)
+(defmethod bounding-rectangle-set-position :around ((window window-mixin) nx ny)
   (declare (ignore nx ny))
   (let ((*synchronous-window-operation-being-processed* t))
     (call-next-method)))
@@ -89,13 +89,25 @@
     (call-next-method)))
 
 ;;; These methods are needed for hooks on other mixins to work.
-(defmethod window-viewport-position* ((window window-mixin))
+(defmethod window-viewport-position ((window window-mixin))
   (with-slots (viewport) window
-    (bounding-rectangle-position* viewport)))
+    (bounding-rectangle-position viewport)))
 
-(defmethod window-set-viewport-position* ((window window-mixin) x y)
+(defmethod window-set-viewport-position ((window window-mixin) x y)
   (with-slots (viewport) window
-    (bounding-rectangle-set-position* viewport x y)))
+    (bounding-rectangle-set-position viewport x y)))
+
+#+CLIM-1-compatibility
+(define-compatibility-function (window-viewport-position*
+				window-viewport-position)
+			       (window)
+  (window-viewport-position window))
+
+#+CLIM-1-compatibility
+(define-compatibility-function (window-set-viewport-position*
+				window-set-viewport-position)
+			       (window x y)
+  (window-set-viewport-position window x y))
 
 (defmethod window-with-zero-viewport-position
 	   ((window window-mixin) continuation)
@@ -103,19 +115,19 @@
   ;; Margin components should not respect the stream transform
   (letf-globally (((medium-transformation window) +identity-transformation+))
     (let ((viewport (window-viewport window)))
-      (multiple-value-bind (x y) (bounding-rectangle-position* viewport)
+      (multiple-value-bind (x y) (bounding-rectangle-position viewport)
 	(unwind-protect
-	    (progn (bounding-rectangle-set-position* viewport 0 0)
+	    (progn (bounding-rectangle-set-position viewport 0 0)
 		   (funcall continuation))
-	  (bounding-rectangle-set-position* viewport x y))))))
+	  (bounding-rectangle-set-position viewport x y))))))
 
 (defmethod window-clear ((window window-mixin))
   (window-erase-viewport window)
   (when (extended-output-stream-p window)	;can we assume this?
-    (stream-set-cursor-position* window 0 0)
+    (stream-set-cursor-position window 0 0)
     (setf (stream-baseline window) 0
 	  (stream-current-line-height window) 0))
-  (bounding-rectangle-set-position* (window-viewport window) 0 0))
+  (bounding-rectangle-set-position (window-viewport window) 0 0))
 
 ;;; Basically a hook for other mixins.
 (defmethod window-refresh ((window window-mixin))
@@ -128,9 +140,9 @@
 
 ;;; --- This needs to be on window-output...
 ;(defmethod window-fresh-page ((stream window-mixin))
-;  (multiple-value-call #'window-set-viewport-position*
+;  (multiple-value-call #'window-set-viewport-position
 ;		       window
-;		       (window-stream-cursor-position* stream)))
+;		       (window-stream-cursor-position stream)))
 ;
 
 (defun window-size-viewport-to-fit (window)
@@ -140,63 +152,60 @@
 
 ;;; Coordinate translations
 
-;;;--- FIXNUM stuff
-
 ;;; The true interfaces: 
 ;;; WINDOW-TO-SCREEN-COORDINATES Window-X Window-Y -> Screen-X Screen-Y
 (defmethod window-to-screen-coordinates ((window window-mixin) x y)
   (declare (type coordinate x y))
   (multiple-value-bind (dx dy) (window-to-screen-coordinate-translations window)
     (declare (type coordinate dx dy))
-    (values (the fixnum (+ x dx)) (the fixnum (+ y dy)))))
+    (values (the coordinate (+ x dx)) (the coordinate (+ y dy)))))
 
 (defmethod screen-to-window-coordinates ((window window-mixin) x y)
   (declare (type coordinate x y))
   (multiple-value-bind (dx dy) (window-to-screen-coordinate-translations window)
     (declare (type coordinate dx dy))
-    (values (the fixnum (- x dx)) (the fixnum (- y dy)))))
+    (values (the coordinate (- x dx)) (the coordinate (- y dy)))))
 	   
 ;;; An internal routine
 (defmethod window-to-screen-coordinate-translations ((window window-mixin))
   (with-slots (left top viewport parent) window
-    (declare (fixnum left top))
+    (declare (type coordinate left top))
     (multiple-value-bind (left-translation top-translation) (window-margins window)
-      (declare (fixnum left-translation top-translation))
-      (setq left-translation (the fixnum (+ left-translation left)))
-      (setq top-translation (the fixnum (+ top-translation top)))
+      (declare (type coordinate left-translation top-translation))
+      (setq left-translation (the coordinate (+ left-translation left)))
+      (setq top-translation (the coordinate (+ top-translation top)))
       (when parent
 	(multiple-value-bind (parent-left parent-top)
 	    (window-to-screen-coordinate-translations parent)
-	  (declare (fixnum parent-left parent-top))
-	  (setq left-translation (the fixnum (+ left-translation parent-left)))
-	  (setq top-translation (the fixnum (+ top-translation parent-top)))))
+	  (declare (type coordinate parent-left parent-top))
+	  (setq left-translation (the coordinate (+ left-translation parent-left)))
+	  (setq top-translation (the coordinate (+ top-translation parent-top)))))
       (when viewport
 	(multiple-value-bind (viewport-left viewport-top)
-	    (bounding-rectangle-position* viewport)
-	  (declare (fixnum viewport-left viewport-top))
-	  (setq left-translation (the fixnum (- left-translation viewport-left)))
-	  (setq top-translation (the fixnum (- top-translation viewport-top)))))
+	    (bounding-rectangle-position viewport)
+	  (declare (type coordinate viewport-left viewport-top))
+	  (setq left-translation (the coordinate (- left-translation viewport-left)))
+	  (setq top-translation (the coordinate (- top-translation viewport-top)))))
       (values left-translation top-translation))))
 
 (defmethod drawing-surface-to-viewport-coordinates ((window window-mixin) dsx dsy)
-  (declare (fixnum dsx dsy))
-  (multiple-value-bind (vx vy) (window-viewport-position* window)
-    (declare (fixnum vx vy))
+  (declare (type coordinate dsx dsy))
+  (multiple-value-bind (vx vy) (window-viewport-position window)
+    (declare (type coordinate vx vy))
     (multiple-value-bind (ml mt) (window-margins window)
-      (declare (fixnum ml mt))
-      (values (the fixnum (+ (the fixnum (- dsx vx)) ml))
-	      (the fixnum (+ (the fixnum (- dsy vy)) mt))))))
+      (declare (type coordinate ml mt))
+      (values (the coordinate (+ (the coordinate (- dsx vx)) ml))
+	      (the coordinate (+ (the coordinate (- dsy vy)) mt))))))
 
 (defmethod viewport-to-drawing-surface-coordinates ((window window-mixin) x y)
-  (declare (fixnum x y))
-  (multiple-value-bind (vx vy) (window-viewport-position* window)
-    (declare (fixnum vx vy))
+  (declare (type coordinate x y))
+  (multiple-value-bind (vx vy) (window-viewport-position window)
+    (declare (type coordinate vx vy))
     (multiple-value-bind (ml mt) (window-margins window)
-      (declare (fixnum ml mt))
-      (values (the fixnum (- (the fixnum (+ x vx)) ml))
-	      (the fixnum (- (the fixnum (+ y vy)) mt))))))
+      (declare (type coordinate ml mt))
+      (values (the coordinate (- (the coordinate (+ x vx)) ml))
+	      (the coordinate (- (the coordinate (+ y vy)) mt))))))
 
-;;;--- FIXNUM stuff
 ;;; Hmm.
 (defmethod bounding-rectangle-set-edges :after ((window window-mixin) left top right bottom)
   (declare (ignore left top right bottom))
@@ -210,29 +219,30 @@
 
 (defmethod window-inside-size ((window window-mixin))
   (multiple-value-bind (left top right bottom) (window-inside-edges window)
-    (declare (fixnum left top right bottom))
-    (values (the fixnum (- right left)) (the fixnum (- bottom top)))))
+    (declare (type coordinate left top right bottom))
+    (values (the coordinate (- right left)) (the coordinate (- bottom top)))))
 
 (defmethod window-inside-edges ((stream window-mixin))
   (multiple-value-bind (lom tom rom bom) (host-window-margins stream)
-    (declare (fixnum lom tom rom bom))
+    (declare (type coordinate lom tom rom bom))
     (multiple-value-bind (lim tim rim bim) (window-margins stream)
-      (declare (fixnum lim tim rim bim))
+      (declare (type coordinate lim tim rim bim))
       (with-bounding-rectangle* (left top right bottom) stream
-	(values (the fixnum (+ left lom lim))  (the fixnum (+ top tom tim))
-		(the fixnum (- right rom rim)) (the fixnum (- bottom bom bim)))))))
+	(values (the coordinate (+ left lom lim))  (the coordinate (+ top tom tim))
+		(the coordinate (- right rom rim)) (the coordinate (- bottom bom bim)))))))
 
 (defmethod window-set-inside-edges ((stream window-mixin) 
 				    new-left new-top new-right new-bottom)
-  (declare (fixnum new-left new-top new-right new-bottom))
   (multiple-value-bind (lom tom rom bom) (host-window-margins stream)
-    (declare (fixnum lom tom rom bom))
+    (declare (type coordinate lom tom rom bom))
     (multiple-value-bind (lim tim rim bim) (window-margins stream)
-      (declare (fixnum lim tim rim bim))
+      (declare (type coordinate lim tim rim bim))
       (bounding-rectangle-set-edges
        stream
-       (the fixnum (- new-left lom lim))  (the fixnum (- new-top tom tim))
-       (the fixnum (+ new-right rom rim)) (the fixnum (+ new-bottom bom bim))))))
+       (the coordinate (- (coordinate new-left)   lom lim))
+       (the coordinate (- (coordinate new-top)    tom tim))
+       (the coordinate (+ (coordinate new-right)  rom rim))
+       (the coordinate (+ (coordinate new-bottom) bom bim))))))
 
 ;; the port needs to define host-window-margins
 
@@ -317,24 +327,22 @@
   ;; for the time being, make the viewport fill the window
   (window-size-viewport-to-fit window))
 
-;;;--- FIXNUM stuff
-
 ;;; Offset from root
 (defun window-offset (stream)
   (let ((x-offset 0)
 	(y-offset 0))
-    (declare (fixnum x-offset y-offset))
+    (declare (type coordinate x-offset y-offset))
     (do ((s stream (window-parent s)))
 	((null s) nil)
-      (multiple-value-bind (x y) (bounding-rectangle-position* s)
-	(declare (fixnum x y))
+      (multiple-value-bind (x y) (bounding-rectangle-position s)
+	(declare (type coordinate x y))
 	(multiple-value-bind (ml mt) (host-window-margins s)
-	  (declare (fixnum ml mt))
-	  (setq x-offset (the fixnum (+ x-offset x ml)))
-	  (setq y-offset (the fixnum (+ y-offset y mt))))))
+	  (declare (type coordinate ml mt))
+	  (setq x-offset (the coordinate (+ x-offset x ml)))
+	  (setq y-offset (the coordinate (+ y-offset y mt))))))
     (values x-offset y-offset)))
 
-;; This is called by OUTPUT-RECORDING-MIXIN's whopper on set-viewport-position*.
+;; This is called by OUTPUT-RECORDING-MIXIN's whopper on SET-VIEWPORT-POSITION.
 ;; It shifts a region of the "host screen" that's visible to some other visible
 ;; location.  It does NOT do any cleaning up after itself.  It does not side-effect
 ;; the output history of the window.  It calls COPY-AREA whose contract is to 
@@ -373,7 +381,7 @@
 	  (multiple-value-bind (ml mt) 
 	      (window-margins window)
 	    (declare (type coordinate ml mt))
-	    (translate-fixnum-positions ml mt from-x from-y)
+	    (translate-coordinates ml mt from-x from-y)
 	    (copy-area window
 		       from-x from-y
 		       (+ from-x width) (+ from-y height)
@@ -395,11 +403,11 @@
 (defmethod stream-advance-cursor-line :after ((stream output-and-window-protocol-intermediary))
   (stream-ensure-cursor-visible stream))
 
-(defmethod stream-set-cursor-position* :after ((stream output-and-window-protocol-intermediary)
+(defmethod stream-set-cursor-position :after ((stream output-and-window-protocol-intermediary)
 					      new-x new-y)
   (stream-ensure-cursor-visible stream new-x new-y))
 
-(defmethod stream-set-cursor-position*-internal :after
+(defmethod stream-set-cursor-position-internal :after
 	   ((stream output-and-window-protocol-intermediary) new-x new-y)
   (stream-ensure-cursor-visible stream new-x new-y))
 
@@ -407,7 +415,7 @@
 					 &optional cx cy)
   (when (or (not (output-recording-stream-p stream))
 	    (stream-drawing-p stream))
-    (unless cy (multiple-value-setq (cx cy) (stream-cursor-position* stream)))
+    (unless cy (multiple-value-setq (cx cy) (stream-cursor-position stream)))
     (with-bounding-rectangle* (vleft vtop vright vbottom) (window-viewport stream)
       (let ((new-x nil)
 	    (new-y nil))
@@ -423,7 +431,7 @@
 	    (setf new-x (max 0 (- cx (- vright vleft 
 					(* 4 (stream-character-width stream #\W))))))))
 	(when (or new-x new-y)
-	  (window-set-viewport-position* stream (or new-x vleft) (or new-y vtop)))))))
+	  (window-set-viewport-position stream (or new-x vleft) (or new-y vtop)))))))
 
 ;;; Rudimentary audio
 
diff --git a/silica/db-border.lisp b/silica/db-border.lisp
index 65545c62..cd834e47 100644
--- a/silica/db-border.lisp
+++ b/silica/db-border.lisp
@@ -5,7 +5,7 @@
 
 (in-package :silica)
 
-;; $fiHeader: db-border.lisp,v 1.4 92/03/10 10:11:34 cer Exp Locker: cer $
+;; $fiHeader: db-border.lisp,v 1.5 92/04/10 14:26:24 cer Exp Locker: cer $
 
 ;;; Border Panes
 (defclass border-pane (layout-pane)
@@ -32,9 +32,8 @@
   
 (defmacro bordering (options &body contents)
   `(make-pane 'border-pane
-		 :contents ,@contents
-		 ,@options))
-
+	      :contents ,@contents
+	      ,@options))
 
 (defclass outlined-pane (border-pane)
   ((background :initform +black+ :accessor pane-background)))
@@ -51,14 +50,14 @@
 
 (defmacro outlining (options &body contents)
   `(make-pane 'outlined-pane
-		 :contents ,@contents
-		 ,@options))
-
+	      :contents ,@contents
+	      ,@options))
 
 (defclass spacing-pane (border-pane) ()
   (:default-initargs :thickness 2))
 
 (defmacro spacing (options &body contents)
   `(make-pane 'spacing-pane
-		 :contents ,@contents
-		 ,@options))
+	      :contents ,@contents
+	      ,@options))
+
diff --git a/silica/db-box.lisp b/silica/db-box.lisp
index 40520483..839978ab 100644
--- a/silica/db-box.lisp
+++ b/silica/db-box.lisp
@@ -22,7 +22,7 @@
 ;;;
 ;;; Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved. 
 ;;;
-;; $fiHeader: db-box.lisp,v 1.9 92/03/04 16:19:26 cer Exp Locker: cer $
+;; $fiHeader: db-box.lisp,v 1.10 92/04/10 14:26:25 cer Exp Locker: cer $
 
 (in-package :silica)
 
diff --git a/silica/db-button.lisp b/silica/db-button.lisp
index 77f51700..e15c3839 100644
--- a/silica/db-button.lisp
+++ b/silica/db-button.lisp
@@ -1,10 +1,10 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: db-button.lisp,v 1.4 92/03/24 19:36:24 cer Exp $
+
 "Copyright (c) 1990, 1991 International Lisp Associates.
  Portions copyright (c) 1991, 1992 by Symbolics, Inc.  All rights reserved."
 
-;; $fiHeader: db-button.lisp,v 1.4 92/03/24 19:36:24 cer Exp Locker: cer $
-
 (in-package :silica)
 
 
@@ -120,7 +120,6 @@
 ;; This is done in the (SETF GADGET-VALUE) method because that's where it 
 ;; would be done in, say, Motif.  (I.e. we'd pass the SET-GADGET-VALUE off
 ;; to Motif which would toggle the indicator.)
-
 (defmethod (setf gadget-value) :after (nv (pane toggle-button-pane) &key)
   (when (port pane)
     ;; If it's not grafted, don't draw it.
@@ -131,8 +130,7 @@
 	       (cx (+ left radius))
 	       (cy (+ top (round (- bottom top) 2))))
 	  (draw-circle* medium cx cy (round radius 2)
-			:ink (if (gadget-value pane) +foreground-ink+
-			       +background-ink+)))))))
+			:ink (if (gadget-value pane) +foreground-ink+ +background-ink+)))))))
 
 (defmethod handle-event ((pane toggle-button-pane) (event pointer-button-press-event))
   (with-slots (armed) pane
@@ -188,6 +186,8 @@
 	   ((selection toggle-button) (client radio-box-pane) gadget-id new-value)
   (declare (ignore gadget-id))
   (let ((old-selection (radio-box-current-selection client)))
+    ;;--- Note the the Motif version of this sets the current selection
+    ;;--- to the ID, *not* the new value.  Howcum?
     (cond ((eql selection old-selection)
 	   (setf (radio-box-current-selection client) (and new-value selection)))
 	  (old-selection
@@ -204,14 +204,15 @@
   (let ((inferiors
 	  (with-look-and-feel-realization (frame-manager frame)
 	    (make-pane 'hbox-pane
-			  :spacing 5
-			  :contents choices))))
+		       :spacing 5
+		       :contents choices))))
     (sheet-adopt-child pane inferiors)
     (when selection
       (setf (gadget-value selection) t))))
 
 ;; This macro is just an example of one possible syntax.  The obvious "core"
-;; syntax is (make-pane 'radio-box :choices (list ...) :selection ...)
+;; syntax is (MAKE-PANE 'RADIO-BOX :CHOICES (LIST ...) :SELECTION ...)
+
 (defmacro with-radio-box ((&rest options) &body body)
   (declare (ignore options))
   (let ((current-selection '#:current-selection)
@@ -221,5 +222,5 @@
 		    `(setq ,',current-selection ,form)))
 	 (let ((,choices (list ,@body)))
 	   (make-pane 'radio-box
-			 :choices ,choices
-			 :selection ,current-selection))))))
+		      :choices ,choices
+		      :selection ,current-selection))))))
diff --git a/silica/db-layout.lisp b/silica/db-layout.lisp
index 5722a524..b6b76ce9 100644
--- a/silica/db-layout.lisp
+++ b/silica/db-layout.lisp
@@ -22,7 +22,7 @@
 ;;;
 ;;; Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved. 
 ;;;
-;; $fiHeader: db-layout.lisp,v 1.10 92/03/24 19:36:26 cer Exp Locker: cer $
+;; $fiHeader: db-layout.lisp,v 1.11 92/03/30 17:52:01 cer Exp $
 
 (in-package :silica)
 
@@ -81,11 +81,10 @@
 (defmethod note-space-requirement-changed (parent child)
   nil)
 
-
 (defmethod note-sheet-region-changed :after ((pane layout-mixin) &key port-did-it)
-    (note-layout-mixin-region-changed pane :port port-did-it))
-   
-(defmethod note-layout-mixin-region-changed ((pane layout-mixin) &key port)
+  (note-layout-mixin-region-changed pane :port port-did-it))
+
+(defmethod note-layout-mixin-region-changed ((pane layout-mixin) &key port)  
   (declare (ignore port))
   (multiple-value-bind (width height) (bounding-rectangle-size pane)
     (allocate-space pane width height)))
@@ -258,12 +257,8 @@ slot that defaults to NIL"))
 					    (height 0)
 					    (min-height height)
 					    (max-height height))
-  (values width
-	  min-width
-	  max-width
-	  height
-	  min-height
-	  max-height))
+  (values width min-width max-width
+	  height min-height max-height))
 
 ;;;;
 
@@ -517,12 +512,10 @@ provided elsewhere"))
     ())
 
 
-;;-- Does this need to be more complicated.
-;; What is the correct behavior. Should it take a space requirement??
-;; and just call allocate-space
-
-(defclass bboard-pane (space-requirement-mixin layout-pane) 
-	  ())
+;;--- Does this need to be more complicated?
+;;--- What is the correct behavior.  Should it take a space requirement?
+;;--- and just call ALLOCATE-SPACE?
+(defclass bboard-pane (space-requirement-mixin layout-pane) ())
 
 (defmethod allocate-space ((pane bboard-pane) width height)
   (declare (ignore width height))
@@ -531,4 +524,3 @@ provided elsewhere"))
       (resize-sheet* child 
 		     (space-requirement-width space-req)
 		     (space-requirement-height space-req)))))
-
diff --git a/silica/db-scroll.lisp b/silica/db-scroll.lisp
index 59dfefb0..e92bf898 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.12 92/04/10 14:26:28 cer Exp Locker: cer $
+;; $fiHeader: db-scroll.lisp,v 1.13 92/04/14 15:29:31 cer Exp Locker: cer $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright(c) 1991, 1992 International Lisp Associates.
@@ -16,8 +16,8 @@
 			 wrapping-space-mixin
 			 layout-pane)
 	  ((scroll-bars :initarg :scroll-bars)
-	   vertical-scrollbar
-	   horizontal-scrollbar
+	   vertical-scroll-bar
+	   horizontal-scroll-bar
 	   contents
 	   viewport)
   (:default-initargs :scroll-bars :both))
@@ -38,34 +38,34 @@
 	      'scroller-pane)
        (sheet-parent (sheet-parent (sheet-parent x)))))
 
-(defmethod gadget-supplies-scrollbars-p ((gadget t))
+(defmethod gadget-supplies-scroll-bars-p ((gadget t))
   nil)
 
 ;;--- Ideally we should use a toolkit scrolling window. This will look
-;;--- exactly right and will deal with user specified placement of scrollbars.
+;;--- exactly right and will deal with user specified placement of scroll-bars.
 ;;--- However the geometry management problems are quite huge.
 
 (defmethod initialize-instance :after ((pane scroller-pane) 
 				       &key contents frame-manager frame
 					    scroll-bars)
-  (if (gadget-supplies-scrollbars-p contents)
+  (if (gadget-supplies-scroll-bars-p contents)
       (sheet-adopt-child pane contents)
     (progn
       (check-type scroll-bars
 	  (member :both :dynamic :vertical :horizontal))
-      (with-slots (vertical-scrollbar horizontal-scrollbar (c contents) viewport) pane
+      (with-slots (vertical-scroll-bar horizontal-scroll-bar (c contents) viewport) pane
 	(with-look-and-feel-realization (frame-manager frame)
 	  (let ((verticalp
 		 (member scroll-bars '(:both :dynamic :vertical)))
 		(horizontalp
 		 (member scroll-bars '(:both :dynamic :horizontal))))
-	    (setf vertical-scrollbar 
+	    (setf vertical-scroll-bar 
 	      (and verticalp
 		   (make-pane 'scroll-bar 
 			      :orientation :vertical
 			      :client pane
 			      :id :vertical))
-	      horizontal-scrollbar 	    
+	      horizontal-scroll-bar 	    
 	      (and horizontalp
 		   (make-pane 'scroll-bar 
 			      :id :horizontal
@@ -76,17 +76,17 @@
 	    (sheet-adopt-child pane
 			       (cond ((and horizontalp verticalp)
 				      (tabling ()
-					       (viewport vertical-scrollbar)
-					       (horizontal-scrollbar
+					       (viewport vertical-scroll-bar)
+					       (horizontal-scroll-bar
 						nil)))
 				     (verticalp
 				      (horizontally ()
 						    viewport
-						    vertical-scrollbar))
+						    vertical-scroll-bar))
 				     (horizontalp
 				      (vertically ()
 						  viewport
-						  horizontal-scrollbar))
+						  horizontal-scroll-bar))
 				     (t
 				      (error "Should not have got here"))))
 
@@ -94,41 +94,40 @@
 	    ;;-- Add callbacks
 	    ))))))
 
-(defun update-scrollbars (vp)
+(defun update-scroll-bars (vp)
   ;;-- This is not the most efficient thing in the world
   (multiple-value-call
-      #'update-dynamic-scrollbars
-    vp (compute-dynamic-scrollbar-values vp))
+      #'update-dynamic-scroll-bars
+    vp (compute-dynamic-scroll-bar-values vp))
   (with-bounding-rectangle* (minx miny maxx maxy)
-    (let ((c (sheet-child vp)))
-      (if (typep c 'clim-internals::output-recording-mixin)
-	  (stream-output-history c)
-	c))
+      (let ((c (sheet-child vp)))
+	;;--- This is a major kludge
+	(if (typep c 'clim-internals::output-recording-mixin)
+	    (stream-output-history c)
+	    c))
     (with-bounding-rectangle* (vminx vminy vmaxx vmaxy)
 	(viewport-viewport-region vp)
-      (with-slots (horizontal-scrollbar vertical-scrollbar)
+      (with-slots (horizontal-scroll-bar vertical-scroll-bar)
 		  (sheet-parent (sheet-parent vp))
-	(update-scrollbar vertical-scrollbar
+	(update-scroll-bar vertical-scroll-bar
 			  miny maxy vminy vmaxy)
-	(update-scrollbar horizontal-scrollbar
+	(update-scroll-bar horizontal-scroll-bar
 			  minx maxx vminx vmaxx)))))
 
-
-;;;--- In the case where the viewport is bigger than the window this
-;;;code gets things kind a wrong. Checkout the thinkadot puzzl. Its
-;;;cos (- (--) (- vminx)) is -ve
-
-(defun update-scrollbar (scrollbar min max vmin vmax)
+;;--- In the case where the viewport is bigger than the window this
+;;--- code gets things wrong. Check out the thinkadot demo.  It's
+;;--- because (- (--) (- vmin)) is negative.
+(defun update-scroll-bar (scroll-bar min max vmin vmax)
   (declare (optimize (safety 0) (speed 3)))
-  (with-slots (current-size current-value) scrollbar
-    ;; Kinda bogus benchmark optimization -- if the scrollbar was full size
+  (with-slots (current-size current-value) scroll-bar
+    ;; Kinda bogus benchmark optimization -- if the scroll-bar was full size
     ;; before, and the viewport is bigger than the extent, don't bother with
     ;; the fancy math.
-    (let ((range (float (gadget-range scrollbar) 0.0s0)))
+    (let ((range (float (gadget-range scroll-bar) 0.0s0)))
       (declare (type single-float range))
       (if (and (and current-size (= (the single-float current-size) range))
 	       (> (- vmax vmin) (- max min)))
-	  (return-from update-scrollbar))
+	  (return-from update-scroll-bar))
       (let* ((size (the single-float
 		     (* range
 		      (the single-float
@@ -147,7 +146,7 @@
 				    (the single-float 
 				      (/ (float (- vmin min) 0.0s0)
 					 (float (- (- max min) (- vmax vmin)) 0.0s0))))))))))
-	     (value (+ (gadget-min-value scrollbar)
+	     (value (+ (gadget-min-value scroll-bar)
 		       (* (- range size) pos))))
 	(declare (type single-float pos size))
 	(unless (and current-size
@@ -156,14 +155,12 @@
 		     (= current-value value))
 	  (setf current-size size
 		current-value value)
-	  (change-scrollbar-values scrollbar 
+	  (change-scroll-bar-values scroll-bar 
 				   :slider-size size
 				   :value value))))))
 
-
-
-(defmethod scrollbar-value-changed-callback :before
-	   ((sheet scrollbar)
+(defmethod scroll-bar-value-changed-callback :before
+	   ((sheet scroll-bar)
 	    (client scroller-pane) 
 	    id value
 	    size)
@@ -173,14 +170,15 @@
 	  current-value (float value 0.0s0))))
   
 
-(defmethod scrollbar-value-changed-callback (sheet 
+(defmethod scroll-bar-value-changed-callback (sheet 
 					      (client scroller-pane) 
 					      id value
 					      size)
   (with-slots (viewport contents) client
+    ;;--- This TYPEP stuff is a major kludge
     (let* ((extent (if (typep contents 'clim-internals::output-recording-mixin)
-		       (stream-output-history contents)
-		     contents))
+ 		       (stream-output-history contents)
+ 		       contents))
 	   (vp viewport)
 	   (viewport (viewport-viewport-region vp)))
       (case id
@@ -206,34 +204,31 @@
 		       (- (gadget-range sheet) size))))
 	    :y (bounding-rectangle-min-y viewport)))))))
 
-(defun update-region (stream nminx nminy nmaxx nmaxy &key no-repaint)
-  ;;-- I suspect that we should pass in mins and maxs since this does
-  ;;-- assume that the window origin is 0,0 and I think that this
-  ;;-- causes the compass menu test to fail since there are graphics at
-  ;;-- -ve coordinates.
-  #-ignore
-  (with-bounding-rectangle* 
-      (l tt r b) stream
-      (when (or (< nminx l)
-		(< nminy tt)
-		(> nmaxx r)
-		(> nmaxy b))
-	(setf (sheet-region stream)
-	  (make-bounding-rectangle  (min nminx l)
-				    (min nminy tt)
-				    (max nmaxx r)
-				    (max nmaxy b)))))
-  #+ignore
-  (let ((width (- nmaxx nminx))
-	(height (- nmaxy nminy)))
-    (when (or (> width (bounding-rectangle-width stream))
+(defun update-region (stream nleft ntop nright nbottom &key no-repaint)
+  ;;--- I suspect that we should pass in mins and maxs since this does
+  ;;--- assume that the window origin is 0,0 and I think that this
+  ;;--- causes the compass menu test to fail since there are graphics at
+  ;;--- negative coordinates.
+  #---ignore
+  (with-bounding-rectangle* (left top right bottom) stream
+    (when (or (< nleft left)
+	      (< ntop  top)
+	      (> nright  right)
+	      (> nbottom bottom))
+      (setf (sheet-region stream)
+	    (make-bounding-rectangle (min nleft left)
+				     (min ntop  top)
+				     (max nright  right)
+				     (max nbottom bottom)))))
+  #+++ignore
+  (let ((width  (- nright  nleft))
+	(height (- nbottom ntop)))
+    (when (or (> width  (bounding-rectangle-width  stream))
 	      (> height (bounding-rectangle-height stream)))
       (setf (sheet-region stream)
-	(make-bounding-rectangle  0 0 
-				  (max (bounding-rectangle-width stream) width)
-				  (max (bounding-rectangle-height
-					stream) height))))))
-
+	    (make-bounding-rectangle 0 0 
+				     (max (bounding-rectangle-width  stream) width)
+				     (max (bounding-rectangle-height stream) height))))))
 
 (defun scroll-extent (stream &key (x 0) (y 0))
   (let ((vp (pane-viewport stream)))
@@ -243,68 +238,55 @@
 	;;;---- This should actually bash the sheet-transformation
 	(setf (sheet-transformation stream)
 	      (make-translation-transformation (- x) (- y)))
-	(bounding-rectangle-set-position* (viewport-viewport-region vp) x y)
-	;;--- Is this the correct place
-	(update-scrollbars vp)
+	(bounding-rectangle-set-position (viewport-viewport-region vp) x y)
+	;;--- Is this the correct place?
+	(update-scroll-bars vp)
 	(with-bounding-rectangle* (nleft ntop nright nbottom) 
-	  (pane-viewport-region stream)
-	  ;;-- Do we really want to do this here??
+	    (pane-viewport-region stream)
+	  ;;--- Do we really want to do this here??
 	  (update-region stream nleft ntop nright nbottom)
 	  (cond
-	   ;; if some of the stuff that was previously on display is still on display
-	   ;; bitblt it into the proper place and redraw the rest.
-	   ((ltrb-overlaps-ltrb-p left top right bottom
-				  nleft ntop nright nbottom)
-	    ;; move the old stuff to the new position
-	    #+ignore
-	    (break "before shifting ~S"
-		   (list (list left top right bottom)
-			 (list nleft ntop nright nbottom)))
-	    (window-shift-visible-region stream 
-					 left top right bottom
-					 nleft ntop nright nbottom)
-	    (let ((rectangles (ltrb-difference nleft ntop nright nbottom
-					       left top right
-					       bottom)))
-	      #+ignore
-	      (break "done shifting")
-	      (with-sheet-medium (medium stream)
-		(dolist (region rectangles)
-		  (multiple-value-call #'draw-rectangle*
-		    medium
-		    (bounding-rectangle* region)
-		    :ink +background-ink+ :filled t)
-		  #+ignore
-		  (break "cleared region ~s" region)
-		  (when (typep stream 'clim-internals::output-recording-mixin)
-		    (replay (stream-output-history stream) stream
-			    region))
-		  #+ignore
-		  (break "done replay")))))
-	   ;; otherwise, just redraw the whole visible viewport
-	   ;; adjust for the left and top margins by hand so clear-area doesn't erase
-	   ;; the margin components.
-	   ((typep stream 'clim-internals::output-recording-mixin)
-	    (let ((region (viewport-viewport-region vp)))
-	      ;;---- we should make the sheet-region bigger at this point
-	      ;; perhaps we do a union of the sheet-region and the viewport
-	      (with-sheet-medium (medium vp)
-		(draw-rectangle* medium
-				 0 0 
-				 (bounding-rectangle-width region)
-				 (bounding-rectangle-height region)
-				 :ink +background-ink+ :filled t))
-	      (replay (stream-output-history stream) stream region)))))))))
-
+	    ;; if some of the stuff that was previously on display is still on display
+	    ;; bitblt it into the proper place and redraw the rest.
+	    ((ltrb-overlaps-ltrb-p left top right bottom
+				   nleft ntop nright nbottom)
+	     ;; move the old stuff to the new position
+	     (window-shift-visible-region stream 
+					  left top right bottom
+					  nleft ntop nright nbottom)
+	     (let ((rectangles (ltrb-difference nleft ntop nright nbottom
+						left top right bottom)))
+	       (with-sheet-medium (medium stream)
+		 (dolist (region rectangles)
+		   (multiple-value-call #'draw-rectangle*
+					medium
+					(bounding-rectangle* region)
+					:ink +background-ink+ :filled t)
+		   (when (typep stream 'clim-internals::output-recording-mixin)
+		     (replay (stream-output-history stream) stream region))))))
+	    ;; otherwise, just redraw the whole visible viewport
+	    ;; adjust for the left and top margins by hand so clear-area doesn't erase
+	    ;; the margin components.
+	    ((typep stream 'clim-internals::output-recording-mixin)
+	     (let ((region (viewport-viewport-region vp)))
+	       ;;---- we should make the sheet-region bigger at this point
+	       ;; perhaps we do a union of the sheet-region and the viewport
+	       (with-sheet-medium (medium vp)
+		 (draw-rectangle* medium
+				  0 0 
+				  (bounding-rectangle-width region)
+				  (bounding-rectangle-height region)
+				  :ink +background-ink+ :filled t))
+	       (replay (stream-output-history stream) stream region)))))))))
 
 
-;;; home-grown scrollbars
+;;; Home-grown scroll-bars
 
 ;;--- orientation, min-value, max-value, unit-increment, page-increment.
 (defclass scroll-bar-pane
-	  (scrollbar
+	  (scroll-bar
 	   pane
-	   ;;--- add immediate-sheet-input-mixin so that scroll bars
+	   ;;--- Add IMMEDIATE-SHEET-INPUT-MIXIN so that scroll bars
 	   ;;--- get handled immediately by the event process?
 	   wrapping-space-mixin
 	   sheet-permanently-enabled-mixin
@@ -319,7 +301,7 @@
   (:default-initargs :value 0
 		     :shaft-thickness 10))
 
-;;--- there should really be a small border around scroll bars so that
+;;--- There should really be a small border around scroll bars so that
 ;;--- they don't butt right up against the viewport's drawing area
 (defmethod initialize-instance :after ((pane scroll-bar-pane)
 				       &key orientation shaft-thickness
@@ -333,31 +315,31 @@
 		    (vertically ()
 		      (setq min-target-pane
 			    (make-pane 'scroll-bar-target-pane
-					  :scroll-bar pane
-					  :end :less-than
-					  :width shaft-thickness
-					  :height shaft-thickness))
+				       :scroll-bar pane
+				       :end :less-than
+				       :width shaft-thickness
+				       :height shaft-thickness))
 		      (setq shaft-pane 
 			    (make-pane 'scroll-bar-shaft-pane 
-					  :scroll-bar pane
-					  :width shaft-thickness
-					  :height 0
-					  :max-height +fill+))
+				       :scroll-bar pane
+				       :width shaft-thickness
+				       :height 0
+				       :max-height +fill+))
 		      (setq max-target-pane
 			    (make-pane 'scroll-bar-target-pane
-					  :scroll-bar pane
-					  :end :greater-than
-					  :width shaft-thickness
-					  :height shaft-thickness)))))
+				       :scroll-bar pane
+				       :end :greater-than
+				       :width shaft-thickness
+				       :height shaft-thickness)))))
 		(:horizontal
 		  (spacing (:thickness 1)
 		    (horizontally ()
 		      (setq min-target-pane
 			    (make-pane 'scroll-bar-target-pane
-					  :scroll-bar pane
-					  :end :less-than
-					  :width shaft-thickness
-					  :height shaft-thickness))
+				       :scroll-bar pane
+				       :end :less-than
+				       :width shaft-thickness
+				       :height shaft-thickness))
 		      (setq shaft-pane 
 			    (make-pane 'scroll-bar-shaft-pane
 					  :scroll-bar pane
@@ -366,13 +348,13 @@
 					  :height shaft-thickness))
 		      (setq max-target-pane
 			    (make-pane 'scroll-bar-target-pane
-					  :scroll-bar pane
-					  :end :greater-than
-					  :width shaft-thickness
-					  :height shaft-thickness))))))))
+				       :scroll-bar pane
+				       :end :greater-than
+				       :width shaft-thickness
+				       :height shaft-thickness))))))))
 	(sheet-adopt-child pane inferiors)))))
 
-(defmethod change-scrollbar-values ((scrollbar scroll-bar-pane) &rest args 
+(defmethod change-scroll-bar-values ((scroll-bar scroll-bar-pane) &rest args 
 					    &key slider-size value)
   (declare (ignore slider-size value))
   )
@@ -404,7 +386,7 @@
 (defmethod sheet-region-changed :after ((pane scroll-bar-target-pane) &key)
   (setf (slot-value pane 'coord-cache) nil))
 
-#+if-we-had-cheap-xforms...
+#+If-we-had-cheap-xforms...
 (defmethod sheet-region-changed :after ((pane scroll-bar-target-pane) &key)
   (let ((cursor (sheet-cursor pane)))
     (ecase cursor
@@ -430,7 +412,7 @@
       :filled nil)
     (draw-target pane medium)))
 
-;;; you can pass :filled t to this in order to highlight the target when clicked on...
+;;; You can pass :filled T to this in order to highlight the target when clicked on...
 (defmethod draw-target ((pane scroll-bar-target-pane) medium
 			&key filled (ink +foreground-ink+))
   (let ((coord-cache (slot-value pane 'coord-cache)))
@@ -601,8 +583,7 @@
 	 (value (compute-symmetric-value min max coord min-value max-value)))
     (setf (gadget-value scroll-bar) value)))
 
-;;;-- This looks like a value gadget to me
-
+;;;--- This looks like a value gadget to me
 (defmethod (setf gadget-value) (nv (pane scroll-bar-pane) &key)
   (with-slots (value) pane
     (setf value nv)))
diff --git a/silica/db-slider.lisp b/silica/db-slider.lisp
index 38fee356..a4534268 100644
--- a/silica/db-slider.lisp
+++ b/silica/db-slider.lisp
@@ -1,10 +1,11 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
+;; $fiHeader: db-slider.lisp,v 1.4 92/03/24 19:36:30 cer Exp $
+
 "Copyright (c) 1990, 1991 International Lisp Associates.
  Portions copyright (c) 1991, 1992 by Symbolics, Inc.  All rights reserved."
 
-;; $fiHeader: db-slider.lisp,v 1.4 92/03/24 19:36:30 cer Exp Locker: cer $
-
+;; $fiHeader: db-slider.lisp,v 1.5 92/04/03 12:04:13 cer Exp Locker: cer $
 (in-package :silica)
 
 
@@ -148,7 +149,6 @@
 	 (value (compute-symmetric-value min max coord min-value max-value)))
     (setf (gadget-value pane) value)))
 
-
 (defmethod (setf gadget-value) :around (nv (pane slider-pane) &key)
   (declare (ignore nv))
   (if (port pane)
diff --git a/silica/db-table.lisp b/silica/db-table.lisp
index 23bd8d64..c17e3c3f 100644
--- a/silica/db-table.lisp
+++ b/silica/db-table.lisp
@@ -22,7 +22,7 @@
 ;;;
 ;;; Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
 ;;;
-;; $fiHeader: db-table.lisp,v 1.8 92/04/10 14:26:29 cer Exp Locker: cer $
+;; $fiHeader: db-table.lisp,v 1.9 92/04/14 15:29:35 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -50,8 +50,8 @@
 
 (defmacro tabling (options &body contents)
   `(make-pane 'table-pane
-		 :contents (list ,@(mapcar #'(lambda (x) `(list ,@x)) contents))
-		 ,@options))
+	      :contents (list ,@(mapcar #'(lambda (x) `(list ,@x)) contents))
+	      ,@options))
 
 (defmethod compose-space ((x table-pane) &key width height)
   (declare (ignore width height))
diff --git a/silica/event.lisp b/silica/event.lisp
index 9a4acf62..1e4ee3eb 100644
--- a/silica/event.lisp
+++ b/silica/event.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: event.lisp,v 1.7 92/03/04 16:19:36 cer Exp $
+;; $fiHeader: event.lisp,v 1.8 92/03/10 10:11:38 cer Exp $
 
 (in-package :silica)
 
@@ -225,8 +225,8 @@
 		       (dotimes (i (fill-pointer v) (fill-pointer v))
 			 (unless (zerop i)
 			   (multiple-value-setq (new-x new-y)
-			     (map-sheet-point*-to-child (aref v i) new-x new-y)))
-			 (unless (region-contains-point*-p 
+			     (map-sheet-position-to-child (aref v i) new-x new-y)))
+			 (unless (region-contains-position-p 
 				   (sheet-region (aref v i)) new-x new-y)
 			   (return i))))
 		     0)))
@@ -237,14 +237,14 @@
 	      (generate-enter-event (aref v (1- i)))))
 	  (setf (fill-pointer v) m)))
       ;; If its empty initialize it
-      (when (region-contains-point*-p (sheet-region sheet) x y)
+      (when (region-contains-position-p (sheet-region sheet) x y)
 	(when (zerop (fill-pointer v))
 	  (vector-push-extend sheet v)
 	  (generate-enter-event sheet))
 	;; We have to get the sheets into the correct coordinate space
 	(loop for i from (1+ (position sheet v)) below (fill-pointer v)
 	    do (multiple-value-setq (x y)
-		 (map-sheet-point*-to-child (aref v i) x y)))
+		 (map-sheet-position-to-child (aref v i) x y)))
 	;; Add children
 	(let ((new-x x)
 	      (new-y y)
@@ -253,13 +253,13 @@
 	  (loop
 	    (unless (typep sheet 'sheet-parent-mixin) 
 	      (return nil))
-	    (setq child (child-containing-point* sheet new-x new-y))
+	    (setq child (child-containing-position sheet new-x new-y))
 	    (unless child
 	      (return nil))
 	    (generate-exit-event sheet)
 	    (generate-enter-event child)
 	    (multiple-value-setq (new-x new-y)
-	      (map-sheet-point*-to-child child new-x new-y))
+	      (map-sheet-position-to-child child new-x new-y))
 	    (setq sheet child)
 	    (vector-push-extend child v)))))))
       
@@ -275,7 +275,7 @@
 		      (aref v (1- (fill-pointer v)))))))
     (when (and sheet (port sheet))
       (multiple-value-bind (tx ty)
-	  (untransform-point*
+	  (untransform-position
 	    (sheet-device-transformation sheet) x y)
 	(dispatch-event
 	  sheet
diff --git a/silica/framem.lisp b/silica/framem.lisp
index 5bef8d40..4a623792 100644
--- a/silica/framem.lisp
+++ b/silica/framem.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: framem.lisp,v 1.3 92/03/24 19:36:37 cer Exp Locker: cer $
+;; $fiHeader: framem.lisp,v 1.4 92/04/10 14:26:31 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -33,11 +33,11 @@
 
 (defun find-frame-manager (&rest options 
 			   &key (port (apply #'find-port options))
-				&allow-other-keys)
+			   &allow-other-keys)
   (declare (dynamic-extent options))
   (second (or (assoc port *frame-managers*)
-		(car (push (list port (make-frame-manager port))
-			   *frame-managers*)))))
+	      (car (push (list port (make-frame-manager port))
+			 *frame-managers*)))))
 
 (defmethod make-frame-manager (port)
   (cerror "Make a default frame manager"
@@ -59,12 +59,10 @@
     (let* ((top-pane (frame-panes frame))
 	   (sheet (with-look-and-feel-realization (framem frame)
 		    (make-pane 'top-level-sheet 
-				  :region (multiple-value-bind (width height)
-					      (bounding-rectangle-size top-pane)
-					    (make-bounding-rectangle 
-					      0 0 width height))
-				  :parent (find-graft
-					   :port (port frame))))))
+			       :region (multiple-value-bind (width height)
+					   (bounding-rectangle-size top-pane)
+					 (make-bounding-rectangle 0 0 width height))
+			       :parent (find-graft :port (port frame))))))
       (setf (frame-top-level-sheet frame) sheet
 	    (frame-shell frame) (sheet-shell sheet))
       (sheet-adopt-child sheet (frame-panes frame)))))
diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp
index f09a863f..70db1fdd 100644
--- a/silica/gadgets.lisp
+++ b/silica/gadgets.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gadgets.lisp,v 1.15 92/04/10 14:26:32 cer Exp Locker: cer $
+;; $fiHeader: gadgets.lisp,v 1.16 92/04/14 15:29:37 cer Exp Locker: cer $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright (c) 1992 by Symbolics, Inc.  All rights reserved."
@@ -34,18 +34,17 @@
 			:reader gadget-disarmed-callback)))
 
 (defmethod armed-callback ((gadget gadget) (client t) (id t))
-  (when (gadget-armed-callback gadget)
-    (invoke-callback-function (gadget-armed-callback gadget) gadget)))
+  (invoke-callback-function (gadget-armed-callback gadget) gadget))
 
 (defmethod disarmed-callback ((gadget gadget) (client t) (id t))
-  (when (gadget-disarmed-callback gadget)
-    (invoke-callback-function (gadget-disarmed-callback gadget) gadget)))
+  (invoke-callback-function (gadget-disarmed-callback gadget) gadget))
 
 (defun invoke-callback-function (function &rest args)
   (declare (dynamic-extent args))
-  (if (consp function)
-      (apply (car function) (append args (cdr function)))
-      (apply function args)))
+  (when function
+    (if (consp function)
+	(apply (car function) (append args (cdr function)))
+	(apply function args))))
 
 
 (defclass value-gadget (gadget) 
@@ -55,8 +54,7 @@
 			     :reader gadget-value-changed-callback)))
 
 (defmethod value-changed-callback ((gadget value-gadget) (client t) (id t) value)
-  (when (gadget-value-changed-callback gadget)
-    (invoke-callback-function (gadget-value-changed-callback gadget) gadget value)))
+  (invoke-callback-function (gadget-value-changed-callback gadget) gadget value))
 
 (defgeneric gadget-value (gadget))
 
@@ -74,17 +72,12 @@
 (defmethod (setf gadget-value) (nv (gadget value-gadget) &key)
   (declare (ignore nv)))
 
-;;-- What is the correct default?
-
+;;--- What is the correct default for INVOKE-CALLBACK?
 (defmethod (setf gadget-value) :after (nv (gadget value-gadget) &key invoke-callback)
   (with-slots (value) gadget
     (setf value nv))
   (when invoke-callback
-    (value-changed-callback
-     gadget 
-     (gadget-client gadget)
-     (gadget-id gadget)
-     nv)))
+    (value-changed-callback gadget (gadget-client gadget) (gadget-id gadget) nv)))
 
 
 (defclass action-gadget (gadget) 
@@ -92,8 +85,7 @@
 			:reader gadget-activate-callback)))  
 
 (defmethod activate-callback ((gadget action-gadget) (client t) (id t))
-  (when (gadget-activate-callback gadget)
-    (invoke-callback-function (gadget-activate-callback gadget) gadget)))
+  (invoke-callback-function (gadget-activate-callback gadget) gadget))
 
 
 ;;; Basic gadgets-mixins
@@ -107,9 +99,9 @@
 (defclass labelled-gadget ()
     ((label :initarg :label
 	    :accessor gadget-label)
-     (alignment :initarg :x-align
+     (alignment :initarg :align-x
 		:accessor gadget-alignment))
-  (:default-initargs :label nil :x-align :center))
+  (:default-initargs :label nil :align-x :center))
 
 ;;--- Do the right thing
 #---ignore
@@ -124,11 +116,10 @@
       (values (+ 4 (stream-string-width text text-style medium))
 	      (+ 4 (text-style-height text-style medium))))))
 
-;;;- We might want a way of changing the range and the value together.
-
+;;--- We might want a way of changing the range and the value together.
 (defclass range-gadget-mixin ()
-	  ((min-value :initarg :min-value :accessor gadget-min-value)
-	   (max-value :initarg  :max-value :accessor gadget-max-value))
+    ((min-value :initarg :min-value :accessor gadget-min-value)
+     (max-value :initarg  :max-value :accessor gadget-max-value))
   (:default-initargs :min-value 0.0 :max-value 1.0))
 
 (defmethod gadget-range ((gadget range-gadget-mixin))
@@ -138,36 +129,34 @@
 (defmethod gadget-range* ((gadget range-gadget-mixin))
   (values (gadget-min-value gadget)
 	  (gadget-max-value gadget)))
+
 
 ;;; The intent is that the real implementations inherit from these
 
 ;;; Slider
-
 (defclass slider
-    (value-gadget oriented-gadget range-gadget-mixin labelled-gadget)
+	  (value-gadget oriented-gadget range-gadget-mixin labelled-gadget)
     ((drag-callback :initarg :drag-callback :initform nil
 		    :reader slider-drag-callback)
      (show-value-p :initarg :show-value-p 
 		   :accessor gadget-show-value-p))
   (:default-initargs :show-value-p nil))
 
+
 (defmethod drag-callback ((gadget slider) (client t) (id t) value)
-  (when (slider-drag-callback gadget)
-    (invoke-callback-function (slider-drag-callback gadget) gadget value)))
+  (invoke-callback-function (slider-drag-callback gadget) gadget value))
 
 
 ;; Scroll bar
-
-(defclass scrollbar
+(defclass scroll-bar
 	  (value-gadget range-gadget-mixin oriented-gadget)
     ((current-value :initform nil)
      (current-size :initform nil)
      (drag-callback :initarg :drag-callback :initform nil
-		    :reader scrollbar-drag-callback)))
+		    :reader scroll-bar-drag-callback)))
 
-(defmethod drag-callback ((gadget scrollbar) (client t) (id t) value)
-  (when (scrollbar-drag-callback gadget)
-    (invoke-callback-function (scrollbar-drag-callback gadget) gadget value)))
+(defmethod drag-callback ((gadget scroll-bar) (client t) (id t) value)
+  (invoke-callback-function (scroll-bar-drag-callback gadget) gadget value))
 
 
 ;;; Push-button
@@ -204,21 +193,24 @@
 	  (value-gadget oriented-gadget) 
     ((selections :initform nil 
 		 :reader radio-box-selections)
-     ;;--- think about this
+     ;;--- think about this...
      (value :initform nil
-	    :initarg :current-selection
-	    :initarg :current
-	    :accessor radio-box-current-selection)))
+ 	    :initarg :current-selection
+ 	    :accessor radio-box-current-selection)))
 
 (defmethod initialize-instance :after ((rb radio-box) &key choices)
-  (let ((fr (pane-frame rb)))
-    (with-look-and-feel-realization ((frame-manager fr) fr)
+  (let ((frame (pane-frame rb)))
+    (with-look-and-feel-realization ((frame-manager frame) frame)
       (dolist (choice choices)
 	(make-pane 'toggle-button 
-		      :value (equal (radio-box-current-selection rb) choice)
-		      :label (string choice)
-		      :id choice
-		      :parent rb)))))
+		   :value (equal (radio-box-current-selection rb) choice)
+		   :label (if (stringp choice)
+			      (string choice)
+			      (gadget-label choice))
+		   :id choice
+		   :parent rb)))))
+
+
 ;;; Menu-bar
 
 
@@ -229,16 +221,15 @@
 ;; As well as the callback mechanism a we want to specify a binding to commands
 (defclass text-field 
 	  (value-gadget action-gadget) 
-	  ())
+    ())
 
 (defclass text-editor (text-field) 
-	  ((ncolumns :initarg :ncolumns
-		     :accessor gadget-columns)
-	   (nlines :initarg :nlines
-		     :accessor gadget-lines))
+    ((ncolumns :initarg :ncolumns
+	       :accessor gadget-columns)
+     (nlines :initarg :nlines
+	     :accessor gadget-lines))
   (:default-initargs :ncolumns 1 :nlines 1))
 
-
 
 ;;; Viewport
 
@@ -261,8 +252,7 @@
   ;;-- Make sure the child is at least as big as the viewport
   ;;-- Viewport-region-changed actually does this also
   (let* ((child (sheet-child viewport)))
-    (multiple-value-bind
-	(cwidth cheight)
+    (multiple-value-bind (cwidth cheight)
 	(bounding-rectangle-size child)
       (when (or (< cwidth width)
 		(< cheight height))
@@ -273,17 +263,17 @@
 (defmethod compose-space ((viewport viewport) &key width height)
   (declare (ignore width height))
   (let ((sr (call-next-method)))
-    (setq sr (silica::copy-space-requirement sr))
+    (setq sr (copy-space-requirement sr))
     (setf (space-requirement-min-width sr) 0
 	  (space-requirement-min-height sr) 0)
     sr))
 
 (defmethod allocate-space :after ((viewport viewport) width height)
   (bounding-rectangle-set-size
-   (viewport-viewport-region viewport) width height)
+    (viewport-viewport-region viewport) width height)
   ;; At this point  it might make sense to move the viewport if it is
   ;; big enough to contain the contents
-  (update-scrollbars viewport)
+  (update-scroll-bars viewport)
   (viewport-region-changed (sheet-child viewport) viewport))
 
 ;;--- Work on this
@@ -293,27 +283,27 @@
   (declare (ignore port-did-it))
   (multiple-value-bind
       (changedp 
-       hscrollbar hscrollbar-enabled-p
-       vscrollbar vscrollbar-enabled-p)
-      (compute-dynamic-scrollbar-values viewport)
+       hscroll-bar hscroll-bar-enabled-p
+       vscroll-bar vscroll-bar-enabled-p)
+      (compute-dynamic-scroll-bar-values viewport)
     (if changedp
-	(update-dynamic-scrollbars 
+	(update-dynamic-scroll-bars 
 	 viewport
 	 changedp
-	 hscrollbar hscrollbar-enabled-p
-	 vscrollbar vscrollbar-enabled-p)
+	 hscroll-bar hscroll-bar-enabled-p
+	 vscroll-bar vscroll-bar-enabled-p)
       (call-next-method))))
 
 
-(defun update-dynamic-scrollbars (viewport
+(defun update-dynamic-scroll-bars (viewport
 				  changedp
-				  hscrollbar hscrollbar-enabled-p
-				  vscrollbar vscrollbar-enabled-p)
+				  hscroll-bar hscroll-bar-enabled-p
+				  vscroll-bar vscroll-bar-enabled-p)
   (when changedp
-    (when hscrollbar
-      (setf (sheet-enabled-p hscrollbar) hscrollbar-enabled-p))
-    (when vscrollbar
-      (setf (sheet-enabled-p vscrollbar) vscrollbar-enabled-p))
+    (when hscroll-bar
+      (setf (sheet-enabled-p hscroll-bar) hscroll-bar-enabled-p))
+    (when vscroll-bar
+      (setf (sheet-enabled-p vscroll-bar) vscroll-bar-enabled-p))
     (let ((table (sheet-parent viewport)))
       (clear-space-requirement-caches-in-tree table)
       (multiple-value-call
@@ -321,9 +311,9 @@
 	table
 	(bounding-rectangle-size table)))))
 
-(defun compute-dynamic-scrollbar-values (viewport)
-  (with-slots ((hscrollbar horizontal-scrollbar )
-	       (vscrollbar vertical-scrollbar)
+(defun compute-dynamic-scroll-bar-values (viewport)
+  (with-slots ((hscroll-bar horizontal-scroll-bar )
+	       (vscroll-bar vertical-scroll-bar)
 	       (scroll-bar-policy scroll-bars))
       (sheet-parent (sheet-parent viewport))
     (if (eq scroll-bar-policy :dynamic)
@@ -333,16 +323,16 @@
 	      (cwidth cheight) 
 	      (bounding-rectangle-size 
 	       (viewport-contents-extent viewport))
-	    (let ((ohenp (sheet-enabled-p hscrollbar))
-		  (ovenp (sheet-enabled-p vscrollbar))
+	    (let ((ohenp (sheet-enabled-p hscroll-bar))
+		  (ovenp (sheet-enabled-p vscroll-bar))
 		  (nhenp (> cwidth vwidth))
 		  (nvenp (> cheight vheight)))
 	      (values
 	       (not (and (eq ohenp nhenp)
 			 (eq ovenp nvenp)))
-	       (and (not (eq ohenp nhenp)) hscrollbar)
+	       (and (not (eq ohenp nhenp)) hscroll-bar)
 	       nhenp
-	       (and (not (eq ovenp nvenp)) vscrollbar)
+	       (and (not (eq ovenp nvenp)) vscroll-bar)
 	       nvenp))))
       (values nil nil nil nil nil))))
 
@@ -352,14 +342,14 @@
 	(stream-output-history c)
       c)))
 
-;;--- Need something in update-scrollbars also.
+;;--- Need something in update-scroll-bars also.
 	    
 ;;; Then there is the layout stuff and scrolling macros
 
 (defmacro scrolling (options &body contents)
   `(make-pane 'scroller-pane
-		 :contents ,@contents
-		 ,@options))
+	      :contents ,@contents
+	      ,@options))
 
 (defmethod make-pane-1 ((framem standard-frame-manager) frame name &rest options)
   (declare (dynamic-extent options))
diff --git a/silica/graphics.lisp b/silica/graphics.lisp
index 7cce79fe..0dec8cbe 100644
--- a/silica/graphics.lisp
+++ b/silica/graphics.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graphics.lisp,v 1.7 92/03/24 19:36:41 cer Exp Locker: cer $
+;; $fiHeader: graphics.lisp,v 1.8 92/04/10 14:26:33 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -88,51 +88,46 @@
 					    arguments)
   (declare (ignore spread-arguments))
   (list
-   `(define-compiler-macro ,spread-name 
-	(&whole form 
-		medium-or-stream 
-		,@spread-argument-names &rest drawing-options-and-keyword-arguments)
-      (or (transform-graphics-function-call 
-	   medium-or-stream
-	   ',medium-graphics-function-name
-	   ',drawing-options
-	   ',other-keyword-arguments
-	   (list ,@spread-argument-names)
-	   drawing-options-and-keyword-arguments)
-	  form))
-   `(define-compiler-macro ,name 
-	(&whole form medium-or-stream ,@unspread-argument-names 
-	 &rest drawing-options-and-keyword-arguments)
-      (or (transform-graphics-function-call 
-	   medium-or-stream
-	   ',medium-graphics-function-name
-	   ',drawing-options
-	   ',other-keyword-arguments
-	   (list ,@unspread-argument-names)
-	   drawing-options-and-keyword-arguments
-	   ',arguments)
-	  form))))
+    `(define-compiler-macro ,spread-name 
+			    (&whole form medium-or-stream ,@spread-argument-names
+			     &rest drawing-options-and-keyword-arguments)
+       (or (transform-graphics-function-call 
+	     medium-or-stream
+	     ',medium-graphics-function-name
+	     ',drawing-options
+	     ',other-keyword-arguments
+	     (list ,@spread-argument-names)
+	     drawing-options-and-keyword-arguments)
+	   form))
+    `(define-compiler-macro ,name 
+			    (&whole form medium-or-stream ,@unspread-argument-names 
+			     &rest drawing-options-and-keyword-arguments)
+       (or (transform-graphics-function-call 
+	     medium-or-stream
+	     ',medium-graphics-function-name
+	     ',drawing-options
+	     ',other-keyword-arguments
+	     (list ,@unspread-argument-names)
+	     drawing-options-and-keyword-arguments
+	     ',arguments)
+	   form))))
 
 (defun generate-argument-spreading-code (x)
   (if (consp x)
       (destructuring-bind (argname type . names) x
 	(ecase type
 	  (point-sequence
-	   (destructuring-bind (new-name) names
-	     (values argname
-		     (list `(unspread-point-sequence ,argname))
-		     (list new-name))))
+	    (destructuring-bind (new-name) names
+	      (values argname
+		      (list `(unspread-point-sequence ,argname))
+		      (list new-name))))
 	  (point
-	   (destructuring-bind (x y) names
-	     (values
-	      argname
-	      (list `(point-x ,argname)
-		    `(point-y ,argname))
-	      (list x y))))))
-    (values
-     x
-     (list x)
-     (list x))))
+	    (destructuring-bind (x y) names
+	      (values argname
+		      (list `(point-x ,argname)
+			    `(point-y ,argname))
+		      (list x y))))))
+      (values x (list x) (list x))))
 
 (defun decode-graphics-function-arguments (arguments)
   (let* ((keyn (position '&key arguments))
@@ -142,12 +137,11 @@
 	 spread-arguments 
 	 spread-argument-names)
     (dolist (x no-keyword)
-      (multiple-value-bind
-	  (argname spread-args spread-values)
+      (multiple-value-bind (argname spread-args spread-values)
 	  (generate-argument-spreading-code x)
-	  (push argname unspread-argument-names)
+	(push argname unspread-argument-names)
 	  (dolist (x spread-args) (push x spread-arguments))
-	  (dolist (x spread-values) (push x spread-argument-names))))
+ 	  (dolist (x spread-values) (push x spread-argument-names))))
     (values (nreverse unspread-argument-names)
 	    (nreverse spread-arguments)
 	    (nreverse spread-argument-names)
@@ -165,14 +159,13 @@
 					 other-keyword-arguments
 					 required-arguments
 					 rest-argument
-					 &optional 
-					 arguments)
+					 &optional arguments)
   (let ((drawing-options
-	 (mapcar #'(lambda (x)
-		     (intern x :keyword))
-		 drawing-options)))
+	  (mapcar #'(lambda (x)
+		      (intern (symbol-name x) :keyword))
+		  drawing-options)))
     (flet ((kw-arg-keyword (x)
-	     (intern (if (consp x) (car x) x) :keyword))
+	     (intern (symbol-name (if (consp x) (car x) x)) :keyword))
 	   (kw-arg-default-value (x)
 	     (and (consp x) (second x))))
       (when (do ((args rest-argument (cddr args)))
@@ -184,96 +177,96 @@
 				(when (eq (kw-arg-keyword arg) (car args))
 				  (return t)))))
 		     (return nil))))
-	(let (bindings)
+	(let ((bindings nil))
 	  (when arguments
 	    (setq required-arguments
-	      (mapcan #'(lambda (arg req-arg)
-			  (let ((g (gensym)))
-			    (push (list g req-arg) bindings)
-			    (if (consp arg)
-				(nth-value
-				 1
-				 (generate-argument-spreading-code
-				  (cons g
-					(cdr arg))))
-			      (list g))))
-		      arguments
-		      required-arguments))
+		  (mapcan #'(lambda (arg req-arg)
+			      (let ((g (gensym)))
+				(push (list g req-arg) bindings)
+				(if (consp arg)
+				    (multiple-value-bind (name spread)
+					(generate-argument-spreading-code
+					  (cons g (cdr arg)))
+				      (declare (ignore name))
+				      spread)
+				    (list g))))
+			  arguments
+			  required-arguments))
 	    (setq bindings (nreverse bindings)))
 	  (let* ((stuff
-		  (do ((args rest-argument (cddr args))
-		       (result nil))
-		      ((null args)
-		       (nreverse result))
-		    (let ((kw (car args))
-			  (value (cadr args)))
-		      (push (list kw (gensym) value) result))))
-		 (medium-or-stream-name (gensym))
+		   (do ((args rest-argument (cddr args))
+			(result nil))
+		       ((null args)
+			(nreverse result))
+		     (let ((kw (car args))
+			   (value (cadr args)))
+		       (push (list kw (gensymbol kw) value) result))))
+		 (medium-or-stream-name (gensymbol 'medium))
 		 (call
-		  `(,medium-graphics-function-name
-		    ,medium-or-stream-name
-		    ,@required-arguments
-		    ,@(mapcar #'(lambda (kw-arg)
-				  (or 
-				   (second (assoc (kw-arg-keyword kw-arg) stuff))
-				   (kw-arg-default-value kw-arg)))
-			      other-keyword-arguments)))
+		   `(,medium-graphics-function-name
+		     ,medium-or-stream-name
+		     ,@required-arguments
+		     ,@(mapcar #'(lambda (kw-arg)
+				   (or (second (assoc (kw-arg-keyword kw-arg) stuff))
+				       (kw-arg-default-value kw-arg)))
+			       other-keyword-arguments)))
 		 (supplied-drawing-options
-		  (mapcan #'(lambda (do)
-			      (let ((x (assoc do stuff)))
-				(and x (list do (second x)))))
-			  drawing-options)))
+		   (mapcan #'(lambda (do)
+			       (let ((x (assoc do stuff)))
+				 (and x (list do (second x)))))
+			   drawing-options)))
 	    
 	    `(let ((,medium-or-stream-name ,medium-or-stream))
 	       (let ,bindings
 		 (let ,(mapcar #'(lambda (x)
-				 (list (second x) (third x)))
-		      stuff)
-		 ,(if supplied-drawing-options
-		      `(with-drawing-options 
+				   (list (second x) (third x)))
+			       stuff)
+		   ,(if supplied-drawing-options
+			`(with-drawing-options 
 			   (,medium-or-stream-name ,@supplied-drawing-options)
-			 ,call)
-		    call))))))))))
-)					;eval-when
+			   ,call)
+		        call))))))))))
+
+)	;eval-when
 
 
-(defmacro transform-points ((transform) &rest points)
-  (when points
-    (assert (evenp (length points)) ()
-	    "Points must be x/y pairs.  There are an odd number of elements in ~S"
-	    points)
+(defmacro transform-positions ((transform) &rest positions)
+  (when positions
+    (assert (evenp (length positions)) ()
+	    "Positions must be x/y pairs.  There are an odd number of elements in ~S"
+	    positions)
     (let ((xform '#:transform))
       `(let ((,xform ,transform))
-	 ,@(do* ((points points (cddr points))
-		 (x (first points) (first points))
-		 (y (second points) (second points))
+	 ,@(do* ((positions positions (cddr positions))
+		 (x (first positions) (first positions))
+		 (y (second positions) (second positions))
 		 (forms nil))
-		((null points) (nreverse forms))
+		((null positions) (nreverse forms))
 	     (push `(multiple-value-setq (,x ,y)
-		      (transform-point* ,xform ,x ,y))
+		      (transform-position ,xform ,x ,y))
 		   forms))
 	 (values)))))
 
-;;; Update the points list in the reference.
-(defmacro transform-point-sequence ((transform) points-reference)
-  (let ((pts-sequence '#:points-sequence)
-	(pts-temp '#:points)
-	(original-pts-temp '#:original-points)
+;;; Update the positions list in the reference.
+(defmacro transform-position-sequence ((transform) positions-reference)
+  (let ((pts-sequence '#:position-sequence)
+	(pts-temp '#:positions)
+	(original-pts-temp '#:original-positions)
 	(xform '#:transform))
     ;;--- is a run-time error check worth it?
-    `(let ((,pts-sequence ,points-reference)
+    `(let ((,pts-sequence ,positions-reference)
 	   (,xform ,transform))
        (assert (evenp (length ,pts-sequence)) ()
-	       "Points must be x/y pairs.  There are an odd number of elements in ~S"
+	       "Positions must be x/y pairs.  There are an odd number of elements in ~S"
 	       ,pts-sequence)
-       (setf ,points-reference
+       (setf ,positions-reference
 	     (let* ((,pts-temp (copy-list ,pts-sequence))
 		    (,original-pts-temp ,pts-temp))
 	       (dorest (pt ,pts-sequence cddr)
 		 (let ((x (first pt))
 		       (y (second pt)))
 		   (multiple-value-bind (nx ny)
-		       (transform-point* ,xform x y)
+		       (transform-position ,xform x y)
 		     (setf (car ,pts-temp) nx
 			   ,pts-temp (cdr ,pts-temp)
 			   (car ,pts-temp) ny
@@ -341,16 +334,6 @@
 	 (setf (get ',name 'args)
 	       '((,@spread-argument-names ,@keyword-argument-names)
 		 ,@args)) 
-	 ,@(write-graphics-function-transformer
-	    name 
-	    medium-graphics-function-name
-	    unspread-argument-names
-	    spread-arguments
-	    spread-name
-	    spread-argument-names
-	    drawing-options
-	    other-keyword-arguments
-	    arguments)
 	 (defmethod ,medium-graphics-function-name ((sheet sheet) 
 						    ,@spread-argument-names
 						    ,@keyword-argument-names)
@@ -364,7 +347,7 @@
 	   (let* ((sheet (medium-sheet medium)))
 	     ;; want to tranform stuff, set up clipping region etc etc
 	     ,@(and points-to-transform
-		    `((transform-points
+		    `((transform-positions
 			((medium-transformation medium))
 			,@points-to-transform)))
 	     ,@(and distances-to-transform
@@ -372,22 +355,25 @@
 			((medium-transformation medium))
 			,@distances-to-transform)))
 	     ,@(mapcar #'(lambda (seq)
-			   `(transform-point-sequence
+			   `(transform-position-sequence
 			      ((medium-transformation medium)) 
 			      ,seq))
 		       point-sequences-to-transform)
 	     (,port-function-name (port medium)
 				  sheet medium
 				  ,@spread-argument-names
-				  ,@keyword-argument-names)))))))
-
-
-
-
-
+				  ,@keyword-argument-names)))
+	 ,@(write-graphics-function-transformer
+	     name 
+	     medium-graphics-function-name
+	     unspread-argument-names
+	     spread-arguments
+	     spread-name
+	     spread-argument-names
+	     drawing-options
+	     other-keyword-arguments
+	     arguments)))))
 
-	       
-			    
 
 (define-graphics-function draw-point ((point point x y))
   :drawing-options :point
@@ -498,7 +484,9 @@
 	(height (pattern-height pattern)))
     (if (or clipping-region transformation)
 	(with-drawing-options (medium :clipping-region clipping-region
-				      :transformation transformation))
+				      :transformation transformation)
+	  (draw-rectangle* medium x y (+ x width) (+ y height)
+			   :filled t :ink pattern))
 	(draw-rectangle* medium x y (+ x width) (+ y height)
 			 :filled t :ink pattern))))
 
diff --git a/silica/layout.lisp b/silica/layout.lisp
index b8575c8a..4fa0521d 100644
--- a/silica/layout.lisp
+++ b/silica/layout.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: layout.lisp,v 1.10 92/04/03 12:04:16 cer Exp Locker: cer $
+;; $fiHeader: layout.lisp,v 1.11 92/04/10 14:26:34 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -94,34 +94,35 @@
 
 (defmacro vertically (options &body contents)
   `(make-pane 'vbox-pane
-		 :contents (list ,@contents)
-		 ,@options))
+	      :contents (list ,@contents)
+	      ,@options))
+
 
 
 (defmacro horizontally (options &body contents)
   `(make-pane 'hbox-pane
-		 :contents (list ,@contents)
-		 ,@options))
+	      :contents (list ,@contents)
+	      ,@options))
+
 
 
 (defmethod resize-sheet* ((sheet sheet) width height &key force)
   (when (or width height)
-    (with-bounding-rectangle* 
-	(minx miny maxx maxy) sheet
-	(when (or force
-		  (and width (/= (- maxx minx) width))
-		  (and height (/= (- maxy miny) height)))
-	  (setf (sheet-region sheet)
-	    (make-bounding-rectangle
-	     minx miny
-	     (if width (+ width minx) maxx)
-	     (if height (+ height miny) maxy)))))))
+    (with-bounding-rectangle* (minx miny maxx maxy) sheet
+      (when (or force
+		(and width (/= (- maxx minx) width))
+		(and height (/= (- maxy miny) height)))
+	(setf (sheet-region sheet)
+	      (make-bounding-rectangle
+		minx miny
+		(if width (+ width minx) maxx)
+		(if height (+ height miny) maxy)))))))
 
 (defmethod move-and-resize-sheet* ((sheet sheet) minx miny width height)
   (resize-sheet* sheet width height)
   (let ((trans (sheet-transformation sheet)))
     (multiple-value-bind (x y)
-	(transform-point* trans 0 0)
+	(transform-position trans 0 0)
       (when (or (and minx (/= x minx))
 		(and miny (/= y miny)))
 	(setf (sheet-transformation sheet)
@@ -133,7 +134,7 @@
 (defmethod move-sheet* ((sheet sheet) minx miny)
   (let ((trans (sheet-transformation sheet)))
     (multiple-value-bind (x y)
-	(transform-point* trans 0 0)
+	(transform-position trans 0 0)
       (when (or (/= x minx)
 		(/= y miny))
 	(setf (sheet-transformation sheet)
@@ -294,43 +295,37 @@
 
 
 ;;--- CLIM 0.9 has some other methods on top-level sheets -- do we want them?
-
 (defclass top-level-sheet 
-    (
-     ;; Have these so that we can use 
-     clim-internals::window-stream
-     ;;
-     pane
-     wrapping-space-mixin
-     mirrored-sheet-mixin
-     sheet-multiple-child-mixin)
+	  (;;--- Temporary kludge until we get the protocols correct
+	   ;;--- so that ACCEPT works correctly on a raw sheet
+	   clim-internals::window-stream
+	   pane
+	   wrapping-space-mixin
+	   mirrored-sheet-mixin
+	   sheet-multiple-child-mixin)
     ()
-  (:default-initargs :text-cursor nil :text-margin 10))
-
-
-;; invoke-with-recording-options
-;; default-text-margin
-;; stream-read-gesture
+    ;;--- More of same...
+    (:default-initargs :text-cursor nil :text-margin 10))
 
+;;--- Needed methods include:
+;;---   INVOKE-WITH-RECORDING-OPTIONS
+;;---   DEFAULT-TEXT-MARGIN
+;;---   STREAM-READ-GESTURE
 
 (defmethod note-layout-mixin-region-changed ((pane top-level-sheet) &key port)
   (if port
       (multiple-value-call #'layout-frame
 	(pane-frame pane) 
 	(bounding-rectangle-size pane))
-    (call-next-method)))
-
-;(defmethod allocate-space ((sheet top-level-sheet) width height)
-;  ;;--- To make openlook windows fill the vertical dimension we need
-;  ;;--- to do this why???. Actually doing this seems to make a lot of sense
-;  ;;--- Perhaps what should happen is that if the sheet-region is
-;  ;;--- changed by the port we should layout the entire frame instead
-;  (clear-space-requirement-caches-in-tree (first (sheet-children sheet)))
-;  ;;
-;  (resize-sheet* (first (sheet-children sheet)) width height))
-;
-;(defmethod compose-space ((sheet top-level-sheet) &key width height)
-;  (compose-space (first (sheet-children sheet)) :width width :height height))
+      (call-next-method)))
+
+#+++ignore
+(defmethod allocate-space ((sheet top-level-sheet) width height)
+  (resize-sheet* (first (sheet-children sheet)) width height))
+
+#+++ignore
+(defmethod compose-space ((sheet top-level-sheet) &key width height)
+  (compose-space (first (sheet-children sheet)) :width width :height height))
 
 
 (defclass leaf-pane 
diff --git a/silica/macros.lisp b/silica/macros.lisp
index 7aa6ddf3..94f94e95 100644
--- a/silica/macros.lisp
+++ b/silica/macros.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: macros.lisp,v 1.7 92/03/24 19:36:46 cer Exp Locker: cer $
+;; $fiHeader: macros.lisp,v 1.8 92/04/10 14:26:36 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -58,10 +58,14 @@
     (setq frame-manager `(frame-manager *application-frame*))
     (setq frame `*application-frame*))
   `(flet ((make-pane (pane-class &rest pane-options)
-		(apply #'make-pane-1 ,frame-manager ,frame pane-class pane-options)))
+	    (declare (dynamic-extent pane-options))
+	    (apply #'make-pane-1 
+		   ,frame-manager ,frame pane-class pane-options)))
+     (declare (dynamic-extent #'make-pane))
      ,@forms))
 
 (defun make-pane (pane-class &rest pane-options)
   (declare (ignore pane-class pane-options))
-  (error "~S not inside a call to ~S"
+  (warn "~S not inside a call to ~S"
 	'make-pane 'with-look-and-feel-realization))
+
diff --git a/silica/mirror.lisp b/silica/mirror.lisp
index 58331ae2..bc51723c 100644
--- a/silica/mirror.lisp
+++ b/silica/mirror.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: mirror.lisp,v 1.13 92/03/24 19:36:47 cer Exp Locker: cer $
+;; $fiHeader: mirror.lisp,v 1.14 92/03/30 17:52:06 cer Exp $
 
 (in-package :silica)
 
@@ -181,6 +181,7 @@
   (when (sheet-direct-mirror sheet)
     (disable-mirror (port sheet) sheet)))
 
+
 ;;--- What sucks big?
 (warn "This sucks big")
 
@@ -188,7 +189,8 @@
   (when (sheet-direct-mirror sheet)
     (update-mirror-region (port sheet) sheet)))
 
-(defmethod note-sheet-region-changed :after ((sheet mirrored-sheet-mixin) &key port-did-it)
+(defmethod note-sheet-region-changed :after ((sheet mirrored-sheet-mixin) 
+					     &key port-did-it)
   (when (sheet-direct-mirror sheet)
     (unless port-did-it
       (update-mirror-region (port sheet) sheet))))
@@ -198,9 +200,10 @@
 ;; invalidate-cached-transformations does it anyway.
 
 #+ignore
-(defmethod note-sheet-transformation-changed :after ((sheet mirrored-sheet-mixin) &key port-did-it)
+(defmethod note-sheet-transformation-changed :after ((sheet mirrored-sheet-mixin) 
+						     &key port-did-it)
   (when (sheet-direct-mirror sheet)
-    (unless port
+    (unless port-did-it
       (update-mirror-region (port sheet) sheet))))
 
 (defun sheet-top-level-mirror (sheet)
diff --git a/silica/pkg.lisp b/silica/pkg.lisp
deleted file mode 100644
index 559af541..00000000
--- a/silica/pkg.lisp
+++ /dev/null
@@ -1,248 +0,0 @@
-;; -*- mode: common-lisp; package: user -*-
-;; 
-;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca.  All rights reserved.
-;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca.  All rights reserved.
-;;
-;; The software, data and information contained herein are proprietary
-;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
-;; given in confidence by Franz, Inc. pursuant to a written license
-;; agreement, and may be stored and used only in accordance with the terms
-;; of such license.
-;;
-;; Restricted Rights Legend
-;; ------------------------
-;; Use, duplication, and disclosure of the software, data and information
-;; contained herein by any agency, department or entity of the U.S.
-;; Government are subject to restrictions of Restricted Rights for
-;; Commercial Software developed at private expense as specified in FAR
-;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
-;; applicable.
-;;
-;; $fiHeader: pkg.lisp,v 1.3 92/01/02 15:09:18 cer Exp Locker: cer $
-
-(defpackage :silica
-  (:use clim-lisp clim-utils)
-  (:export
-   #:*default-text-style*
-   #:*null-text-style*
-   #:*standard-character-set* 
-   #:*undefined-text-style* 
-   #:+fill+
-   #:action-gadget
-   #:activate-gadget-event
-   #:add-text-style-mapping
-   #:adopt-child
-   #:adopt-frame
-   #:allocate-space
-   #:application-frame
-   #:beep
-   #:canvas
-   #:char-character-set-and-index
-   #:char-width
-   #:click-event
-   #:compose-space
-   #:copy-area
-   #:copy-area*
-   #:define-character-face
-   #:define-character-face-added-mappings
-   #:define-character-face-class
-   #:define-display-device
-   #:define-text-style-mappings 
-   #:diacritic-char-p
-   #:disable-mirror
-   #:dispatch-event
-   #:dispatch-repaint
-   #:display-device 
-   #:distribute-event
-   #:draw-circle
-   #:draw-circle*
-   #:draw-ellipse
-   #:draw-ellipse*
-   #:draw-image
-   #:draw-image*
-   #:draw-line
-   #:draw-line* 
-   #:draw-lines
-   #:draw-lines*
-   #:draw-point 
-   #:draw-point* 
-   #:draw-points 
-   #:draw-points*
-   #:draw-polygon
-   #:draw-polygon*
-   #:draw-rectangle
-   #:draw-rectangle*
-   #:draw-spline
-   #:draw-spline*
-   #:draw-text
-   #:draw-text*
-   #:draw-text-rectangle
-   #:draw-text-rectangle*
-   #:enable-mirror
-   #:engraft-medium
-   #:event-modifier-key-state
-   #:event-sheet
-   #:find-graft
-   #:find-port
-   #:find-port-type
-   #:frame-manager
-   #:frame-name
-   #:frame-panes
-   #:frame-shell
-   #:frame-top-level-sheet
-   #:gadget
-   #:get-port-canonical-gesture-spec
-   #:graft
-   #:graftp
-   #:handle-repaint
-   #:intern-text-style
-   #:key-press-event
-   #:key-release-event
-   #:keyboard-event-character
-   #:keyboard-event-key-name
-   #:make-frame-manager
-   #:make-medium
-   #:make-rectangle*
-   #:medium
-   #:medium-background
-   #:medium-clipping-region
-   #:medium-default-text-style
-   #:medium-draw-text
-   #:medium-foreground
-   #:medium-ink
-   #:medium-line-style
-   #:medium-sheet
-   #:medium-text-style
-   #:medium-transformation
-   #:merge-text-styles 
-   #:merged-text-style 
-   #:mirror-inside-edges*
-   #:mirror-native-edges*
-   #:mirror-region
-   #:mirror-region*
-   #:mirror-region-updated
-   #:mirrored-sheet-mixin
-   #:modifier-keysym
-   #:mute-repainting-mixin
-   #:note-frame-disabled
-   #:note-frame-enabled
-   #:note-sheet-grafted
-   #:note-sheet-region-changed
-   #:parse-gesture-spec
-   #:parse-text-style 
-   #:permanent-medium-sheet-output-mixin
-   #:pointer-button-event
-   #:pointer-enter-event
-   #:pointer-event-native-x
-   #:pointer-event-native-y
-   #:pointer-event-x
-   #:pointer-event-y
-   #:pointer-exit-event
-   #:pointer-motion-event
-   #:pointer-native-event-x
-   #:pointer-native-event-y
-   #:pointer-press-event
-   #:pointer-release-event
-   #:port
-   #:port-color-cache
-   #:port-draw-line*
-   #:port-draw-rectangle*
-   #:port-draw-text*
-   #:port-event-wait
-   #:port-force-output
-   #:port-glyph-for-character
-   #:port-pointer
-   #:process-next-event
-   #:push-button
-   #:queue-event
-   #:realize-graft
-   #:realize-mirror
-   #:make-pane-internal
-   #:repaint-sheet
-   #:set-sheet-mirror-edges*
-   #:sheet
-   #:sheet-actual-native-edges
-   #:sheet-children
-   #:sheet-device-region
-   #:sheet-device-transformation
-   #:sheet-direct-mirror
-   #:sheet-enabled-p
-   #:sheet-height
-   #:sheet-leaf-mixin
-   #:sheet-medium
-   #:sheet-mirror
-   #:sheet-mirrored-ancestor
-   #:sheet-multiple-child-mixin
-   #:sheet-mute-input-mixin
-   #:sheet-native-transformation
-   #:sheet-parent
-   #:sheet-permanently-enabled-mixin
-   #:sheet-region
-   #:sheet-single-child-mixin
-   #:sheet-transformation
-   #:sheet-transformation-mixin
-   #:sheet-width
-   #:slider
-   #:standard-repainting-medium
-   #:standard-sheet
-   #:standard-sheet-input-mixin
-   #:standarize-style
-   #:stream-glyph-for-character
-   #:string-height 
-   #:string-width 
-   #:text-field
-   #:text-style
-   #:text-style-ascent 
-   #:text-style-components
-   #:text-style-descent 
-   #:text-style-face
-   #:text-style-family 
-   #:text-style-height
-   #:text-style-mapping 
-   #:text-style-scale 
-   #:text-style-size
-   #:toggle-button
-   #:transform-point*
-   #:value-changed-gadget-event
-   #:value-gadget
-   #:window-configuration-event
-   #:window-repaint-event
-   #:with-drawing-options
-   #:with-rotation with-scaling
-   #:with-sheet-medium
-   #:with-text-face
-   #:with-text-family
-   #:with-text-size
-   #:with-text-style 
-   #:with-translation
-   #:stream-write-string-internal
-   #:make-application-frame
-   #:enable-frame
-   #:sheet-event-queue
-   #:port-note-cursor-change
-   #:update-scrollbars
-   #:event
-   #:make-text-style
-   #:pointer-event-button
-   #:medium-+y-upward-p
-   #:define-application-frame
-   #:run-frame-top-level
-   #:vertically
-   #:make-pane
-   #:space-req-height
-   #:space-req-width
-   #:scroller-pane
-   
-   #:medium-merged-text-style
-   #:medium-default-text-style
-   #:medium-text-style
-   #: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 76285a13..a055a86b 100644
--- a/silica/port.lisp
+++ b/silica/port.lisp
@@ -19,14 +19,19 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: port.lisp,v 1.8 92/03/10 10:11:43 cer Exp Locker: cer $
+;; $fiHeader: port.lisp,v 1.9 92/03/24 19:36:49 cer Exp $
 
 (in-package :silica)
 
 
 ;; Ports and grafts
 
-(defvar *default-server-path* '(:motif))
+(defvar *default-server-path* #+Allegro '(:motif)
+			      #+Lucid '(:openlook)
+			      #+Genera `(:genera :host ,net:*local-host*
+						 :screen ,tv:main-screen)
+			      #-(or Allegro Lucid Genera) nil)
+
 (defvar *ports* nil)
 (defvar *port-type-mapping* nil)
 
@@ -67,17 +72,15 @@
   (declare (dynamic-extent function))
   (mapc function *ports*))
 
-(defgeneric restart-port (port)
-  )
+(defgeneric restart-port (port))
 
 (defmethod restart-port ((port port))
   (when (port-process port)
     (destroy-process (port-process port)))
   (setf (port-process port)
-    (make-process #'(lambda () (port-event-loop port))
-		  :name (format nil
-				"CLIM Event Dispatcher for ~A"
-				(port-server-path port)))))
+	(make-process #'(lambda () (port-event-loop port))
+		      :name (format nil "CLIM Event Dispatcher for ~A"
+			      (port-server-path port)))))
 
 (defgeneric port-event-loop (port)
   (:method ((port port))
@@ -113,11 +116,12 @@
   (:method ((x graft)) t)
   (:method ((x t)) nil))
 
-(defun find-graft (&key 
-		   (server-path *default-server-path*)
-		   (orientation :default)
-		   (units :device)
-		   (port (find-port :server-path server-path)))
+(defun find-graft (&key (server-path *default-server-path*)
+			(port (find-port :server-path server-path))
+			(orientation :default)
+			(units :device))
+  (unless port
+    (setq port (find-port :server-path server-path)))
   (map-over-grafts #'(lambda (graft)
 		       (when (graft-matches-spec graft orientation units)
 			 (return-from find-graft graft)))
@@ -134,8 +138,6 @@
   (pushnew graft (port-grafts port))
   (realize-graft port graft))
 
-
-
 (defmethod update-mirror-region ((port port) (sheet graft))
   ;;--- I don't think we ever change the region of a graft...
   )
diff --git a/silica/sheet.lisp b/silica/sheet.lisp
index 8db70041..b8bbd381 100644
--- a/silica/sheet.lisp
+++ b/silica/sheet.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: sheet.lisp,v 1.8 92/03/24 19:36:50 cer Exp Locker: cer $
+;; $fiHeader: sheet.lisp,v 1.9 92/03/30 17:52:08 cer Exp $
 
 (in-package :silica)
 
@@ -134,37 +134,35 @@
 
 ;;;;
 
-(defgeneric map-sheet-point*-to-parent (sheet x y)
+(defgeneric map-sheet-position-to-parent (sheet x y)
   (:method (sheet x y)
-   (transform-point* (sheet-transformation sheet) x y)))
+   (transform-position (sheet-transformation sheet) x y)))
 
 
-(defgeneric map-sheet-point*-to-child (sheet x y)
+(defgeneric map-sheet-position-to-child (sheet x y)
   (:method (sheet x y)
-   (untransform-point* (sheet-transformation sheet) x y)))
+   (untransform-position (sheet-transformation sheet) x y)))
 
-(defgeneric map-child-bounding-rectangle*-to-parent (sheet min-x min-y max-x max-y)
+(defgeneric map-sheet-rectangle*-to-parent (sheet min-x min-y max-x max-y)
   (:method (sheet min-x min-y max-x max-y)
    (transform-rectangle*
      (sheet-transformation sheet)
      min-x min-y max-x max-y)))
 
-(defgeneric map-parent-bounding-rectangle*-to-child (sheet min-x min-y max-x max-y)
+(defgeneric map-sheet-rectangle*-to-child (sheet min-x min-y max-x max-y)
   (:method (sheet min-x min-y max-x max-y)
    (untransform-rectangle*
      (sheet-transformation sheet)
      min-x min-y max-x max-y)))
 
-(defgeneric child-containing-point (sheet point))
+(defgeneric child-containing-position (sheet x y))
 
-(defgeneric child-containing-point* (sheet x y))
-
-(defmethod child-containing-point* (sheet x y)
+(defmethod child-containing-position (sheet x y)
   (find-if #'(lambda (child)
 	       (and (sheet-enabled-p child)
 		    (multiple-value-bind (x y)
-			(untransform-point* (sheet-transformation child) x y)
-		      (region-contains-point*-p (sheet-region child) x y))))
+			(untransform-position (sheet-transformation child) x y)
+		      (region-contains-position-p (sheet-region child) x y))))
 	   (sheet-children sheet)))
 
 
@@ -247,30 +245,33 @@
      (or (graftp parent)
 	 (sheet-engrafted-p parent)))))
 
-;;---
 
 (defmethod (setf sheet-region) :after (nv sheet)
   (note-sheet-region-changed sheet))
 
 (defgeneric note-sheet-region-changed (sheet &key port-did-it)
-  (:method (sheet &key port-did-it) (declare (ignore port-did-it)) nil))
+  (:method (sheet &key port-did-it)
+   (declare (ignore port-did-it))
+   nil))
 
+;;--- 
 (defmethod (setf sheet-transformation) :after (nv sheet)
   (note-sheet-transformation-changed sheet))
 
 (defgeneric note-sheet-transformation-changed (sheet &key port-did-it)
-  (:method (sheet &key port-did-it) (declare (ignore port-did-it)) nil))
-
+  (:method (sheet &key port-did-it) 
+   (declare (ignore port-did-it)) 
+   nil))
 
 (defgeneric invalidate-cached-transformations (sheet)
   (:method ((sheet t)) nil)
   (:method :after ((sheet sheet-parent-mixin))
-	   (mapc #'invalidate-cached-transformations (sheet-children sheet))))
+    (mapc #'invalidate-cached-transformations (sheet-children sheet))))
 	     
 (defgeneric invalidate-cached-regions (sheet)
-    (:method ((sheet t)) nil)
+  (:method ((sheet t)) nil)
   (:method :after ((sheet sheet-parent-mixin))
-	   (mapc #'invalidate-cached-regions (sheet-children sheet))))
+    (mapc #'invalidate-cached-regions (sheet-children sheet))))
 
 (defmethod note-sheet-region-changed :before (sheet &key port-did-it)
   (declare (ignore port-did-it))
@@ -282,7 +283,6 @@
   (invalidate-cached-transformations sheet)
   (invalidate-cached-regions sheet))
 
-
 (defgeneric update-native-transformation (port sheet))
 
 (defmethod (setf sheet-enabled-p) :after  (nv (sheet sheet))
diff --git a/sys/defsystem.lisp b/sys/defsystem.lisp
index a2543564..783f7dfd 100644
--- a/sys/defsystem.lisp
+++ b/sys/defsystem.lisp
@@ -27,7 +27,7 @@
 ;;;
 ;;;-----------------------------------------------------------
 
-;; $fiHeader: defsystem.lisp,v 1.7 92/03/30 17:52:33 cer Exp Locker: cer $
+;; $fiHeader: defsystem.lisp,v 1.8 92/04/10 14:27:11 cer Exp Locker: cer $
 
 ;; Add a feature for ANSI-adhering Lisps.  So far, only Apple's
 ;; version 2.0 tries to do adhere to the ANSI spec instead of CLtL rev 1.
@@ -1072,7 +1072,10 @@ pathname fields are evaluated."
 
 #-(and ANSI-90 (not Allegro) (not Cloe))
 (#+Allegro excl::without-package-locks #-Allegro progn
-	   (defun translate-logical-pathname (path) path))
+
+(defun translate-logical-pathname (path) path)
+	   
+)
 
 ;; Evaluate the BODY with the reader context and default pathname set up as
 ;; defined by the module.
diff --git a/sys/sysdcl.lisp b/sys/sysdcl.lisp
index 69193d00..6d51331f 100644
--- a/sys/sysdcl.lisp
+++ b/sys/sysdcl.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: sysdcl.lisp,v 1.11 92/04/03 12:04:39 cer Exp Locker: cer $
+;; $fiHeader: sysdcl.lisp,v 1.12 92/04/10 14:27:13 cer Exp Locker: cer $
 
 (in-package #-ANSI-90 "USER" #+ANSI-90 :cl-user)
 
@@ -277,9 +277,9 @@
   ("window-stream")
 
   ;; Presentation types
-  ("completer")
   ("ptypes1"
    :load-before-compile ("clim-defs"))
+  ("completer")
   ("presentations"
    :load-before-compile ("ptypes1"))
   ("translators"
@@ -385,7 +385,7 @@
 (clim-defsys:defsystem genera-clim
     (:default-pathname "SYS:CLIM;REL-2;GENERA;"
      :default-binary-pathname #+Genera "SYS:CLIM;REL-2;GENERA;"
-     :needed-systems (clim-standalone)
+o     :needed-systems (clim-standalone)
      :load-before-compile (clim-standalone))
   ("pkgdcl")
   ("genera-port")
@@ -412,9 +412,9 @@
 #+(and Silica Allegro)
 (clim-defsys:defsystem xlib
     (:default-pathname (frob-pathname "xlib")
-	:default-binary-pathname (frob-pathname "xlib")
-	:needed-systems (clim-standalone)
-	:load-before-compile (clim-standalone))
+     :default-binary-pathname (frob-pathname "xlib")
+     :needed-systems (clim-standalone)
+     :load-before-compile (clim-standalone))
   ("pkg")
   #+++ignore ("ffi" :eval-after (mapc #'load '("xlib/xlib.lisp" "xlib/x11-keysyms.lisp"
 					       "xlib/last.lisp")))
@@ -425,7 +425,6 @@
   ("x11-keysyms" :load-before-compile ("ffi"))
   ("last" :load-before-compile ("load-xlib" "xlib-funs")))
 
-
 #+(and Silica Allegro)
 (clim-defsys:defsystem xt-tk
     (:default-pathname (frob-pathname "tk")
@@ -443,7 +442,7 @@
   ("graphics")
   
   ;; Toolkit stuff
-  ;;; ("load-xt")
+  ;; ("load-xt")
   ("xtk")
   ("meta-tk")
   ("make-classes")
@@ -462,11 +461,11 @@
      :needed-systems (xt-tk)
      :load-before-compile (xt-tk))
   ;; Motif specific stuff
-  ("xm-classes")
   ("load-xm")
   ;;--- This is really in tk but because of the loading
   ("xt-funs")
   ("xm-funs")
+  ("xm-classes")
   ("xm-init")
   ("xm-widgets")
   ("xm-font-list")
@@ -484,9 +483,9 @@
      :needed-systems (xt-tk)
      :load-before-compile (xt-tk))
   ;; OpenLook specific stuff
-  ("ol-classes")
   ("load-ol")
   ("xt-funs")
+  ("ol-classes")
   ("ol-init")
   ("ol-callbacks")
   #+ignore("ol-examples")
@@ -620,12 +619,12 @@
 #+(and Silica ignore)
 (clim-defsys:import-into-sct 'motif-clim :subsystem t
 			:pretty-name "Motif CLIM"
-			:default-pathname "SYS:CLIM;REL-2;XM-SILICA;")
+			:default-pathname "SYS:CLIM;REL-2;TK-SILICA;")
 
 #+(and Silica ignore)
 (clim-defsys:import-into-sct 'openlook-clim :subsystem t
 			:pretty-name "OpenLook CLIM"
-			:default-pathname "SYS:CLIM;REL-2;XM-SILICA;")
+			:default-pathname "SYS:CLIM;REL-2;TK-SILICA;")
 
 #+(and Silica ignore)
 (sct:defsystem clim-tags-table
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index c31e9511..6ad6dd10 100644
--- a/test/test-suite.lisp
+++ b/test/test-suite.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: test-suite.lisp,v 1.14 92/03/24 19:38:02 cer Exp Locker: cer $
+;; $fiHeader: test-suite.lisp,v 1.15 92/04/10 14:27:18 cer Exp Locker: cer $
 
 (in-package :clim-user)
 
@@ -812,7 +812,7 @@ people, shall not perish from the earth.
 	 (rect-width (- (floor width 11) 10))
 	 (spacing 8))
     (multiple-value-bind (x y)
-	(stream-cursor-position* stream)
+	(stream-cursor-position stream)
       (dotimes (i 11)
 	(stream-set-cursor-position* stream x y)
 	(write-string (format nil "~1$" (float (/ i 10))) stream)
@@ -1213,7 +1213,7 @@ Luke Luck licks the lakes Luke's duck likes."))
 
 (define-table-cell-test stream-cursor-position "multiple-value-bind, draw-rectangle"
   (multiple-value-bind (x y)
-      (stream-cursor-position* stream)
+      (stream-cursor-position stream)
     (draw-rectangle* stream x y (+ x 10) (+ y 10) :ink +yellow+)))
 
 (define-table-cell-test simple-surrounding "create record, query size, surround with rect"
@@ -2050,49 +2050,49 @@ Luke Luck licks the lakes Luke's duck likes."))
        (y start-y (+ y delta)))
       ((= y y-excursion))
     (declare (fixnum x y))
-    (window-set-viewport-position* stream x y)
+    (window-set-viewport-position stream x y)
     (force-output stream))
   (do ((x start-x)
        (y y-excursion (- y delta)))
       ((= y start-y))
     (declare (fixnum x y))
-    (window-set-viewport-position* stream x y)
+    (window-set-viewport-position stream x y)
     (force-output stream))
   (do ((x start-x (+ x delta))
        (y start-y))
       ((= x x-excursion))
     (declare (fixnum x y))
-    (window-set-viewport-position* stream x y)
+    (window-set-viewport-position stream x y)
     (force-output stream))
   (do ((x x-excursion (- x delta))
        (y start-y))
       ((= x start-x))
     (declare (fixnum x y))
-    (window-set-viewport-position* stream x y)
+    (window-set-viewport-position stream x y)
     (force-output stream)))
 
 (define-benchmark (text-scrolling) (stream)
   "Scroll a window full of text, horizontally and vertically"
   (multiple-value-bind (start-x start-y)
-      (window-viewport-position* stream)
+      (window-viewport-position stream)
     (repeat 25
       (write-string "Four score and seven years ago, our fathers..." stream)
       (terpri stream))
     (force-output stream)
-    (window-set-viewport-position* stream start-x start-y)
+    (window-set-viewport-position stream start-x start-y)
     (scroll-kernel stream start-x start-y 400 400 25)))
 
 (define-benchmark (graphics-scrolling) (stream)
   "Scroll a window full of graphics, horizontally and vertically"
   (multiple-value-bind (start-x start-y)
-      (window-viewport-position* stream)
+      (window-viewport-position stream)
     (line-drawing-kernel stream 20)
     (shape-drawing-kernel stream 10 nil :clear nil)
     (scroll-kernel stream start-x start-y 400 400 25)))
 
 (defun refresh-kernel (stream iterations start-x start-y)
   (force-output stream)
-  (window-set-viewport-position* stream start-x start-y)
+  (window-set-viewport-position stream start-x start-y)
   (repeat iterations
     (window-refresh stream)
     (force-output stream)))
@@ -2100,7 +2100,7 @@ Luke Luck licks the lakes Luke's duck likes."))
 (define-benchmark (text-refresh) (stream)
   "Refresh a window full of text"
   (multiple-value-bind (start-x start-y)
-      (window-viewport-position* stream)
+      (window-viewport-position stream)
     (repeat 25
       (write-string "Four score and seven years ago, our fathers..." stream)
       (terpri stream))
@@ -2109,7 +2109,7 @@ Luke Luck licks the lakes Luke's duck likes."))
 (define-benchmark (graphics-refresh) (stream)
   "Refresh a window full of graphics"
   (multiple-value-bind (start-x start-y)
-      (window-viewport-position* stream)
+      (window-viewport-position stream)
     (line-drawing-kernel stream 20)
     (shape-drawing-kernel stream 10 nil :clear nil)
     (refresh-kernel stream 5 start-x start-y)))
@@ -2213,7 +2213,7 @@ Luke Luck licks the lakes Luke's duck likes."))
 	((>= y 200))
       (do ((x 0 (+ x 15)))
 	  ((>= x 450))
-	(stream-set-pointer-position* stream x y)
+	(stream-set-pointer-position stream x y)
 	 (highlight-applicable-presentation
 	   *application-frame* stream input-context nil)))))
 
@@ -2222,7 +2222,7 @@ Luke Luck licks the lakes Luke's duck likes."))
 (defun draw-menu-benchmark (stream)
   (fresh-line stream)
   (multiple-value-bind (x0 y0)
-      (stream-cursor-position* stream)
+      (stream-cursor-position stream)
     (declare (ignore x0))
     (formatting-item-list (stream :move-cursor t)
       (dolist (item '(("Red" :value +red+)
@@ -2241,7 +2241,7 @@ Luke Luck licks the lakes Luke's duck likes."))
     (fresh-line stream)
     (force-output stream)
     (multiple-value-bind (x1 y1)
-	(stream-cursor-position* stream)
+	(stream-cursor-position stream)
       (declare (ignore x1))
       (values y0 y1))))
 
@@ -2254,7 +2254,7 @@ Luke Luck licks the lakes Luke's duck likes."))
       (repeat 10
 	(do ((y y0 (+ y 3)))
 	    ((>= y y1))
-	  (stream-set-pointer-position* stream 20 y)
+	  (stream-set-pointer-position stream 20 y)
 	  (highlight-applicable-presentation
 	    *application-frame* stream input-context nil))))))
 
diff --git a/test/test.lisp b/test/test.lisp
index a14f6ba8..44f236db 100644
--- a/test/test.lisp
+++ b/test/test.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: test.lisp,v 1.18 92/04/03 12:04:42 cer Exp Locker: cer $
+;; $fiHeader: test.lisp,v 1.19 92/04/10 14:27:21 cer Exp Locker: cer $
 
 (in-package :clim-user)
 
@@ -51,13 +51,13 @@
     (scrolling ()
 	       (make-pane 'interactor-pane))))
 
+
 (define-application-frame test-frame01 () ()
   (:command-table test-frame)
   (:pane 
     (scrolling ()
       (make-pane 'interactor-pane))))
 
-
 (define-application-frame test-frame2 () ()
   (:command-table test-frame)
   (:pane 
@@ -182,9 +182,9 @@
 	(d 10))
     (accepting-values (stream :own-window own-window)
       (clim-internals::letf-globally (((stream-default-view stream)
-		       (if textual-view 
-			   +textual-dialog-view+
-			   (stream-default-view stream))))
+				       (if textual-view 
+					   +textual-dialog-view+
+					 (stream-default-view stream))))
 	(setq a (accept 'boolean  
 			:stream stream
 			:default a :prompt "a"))
@@ -236,7 +236,7 @@
       (setf (car weird)
 	    (with-output-as-presentation (stream weird 'some-kinda-gadget)
 	      (surrounding-output-with-border (stream)
-		(clim-internals::with-output-as-gadget (stream)
+		(with-output-as-gadget (stream)
 		  (scrolling ()
 		    (make-pane 'interactor-pane)))))))))
 
@@ -345,7 +345,6 @@
 (defun slider-dragged-callback (slider value)
   (format t "~&Slider ~A dragged to ~S" (gadget-label slider) value))
 
-
 (defun text-field-changed (tf value)
   (format t "~&Text field ~A changed to ~S"  tf value))
 
@@ -364,6 +363,7 @@
 	  :prompt "Select an insect"))
   (describe bug))
 
+
 (define-application-frame tf100 
     () ()
     (:command-table test-frame)
@@ -381,6 +381,7 @@
 					  :ncolumns 30
 					  :nlines 10)))))
 
+
 (define-application-frame tf99 () ()
   (:command-table test-frame)
   (:pane 
diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp
index 169df93d..f03fa8c5 100644
--- a/tk-silica/ol-gadgets.lisp
+++ b/tk-silica/ol-gadgets.lisp
@@ -20,14 +20,14 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-gadgets.lisp,v 1.7 92/03/24 19:37:01 cer Exp Locker: cer $
+;; $fiHeader: ol-gadgets.lisp,v 1.8 92/04/10 14:27:47 cer Exp Locker: cer $
 
 
 (in-package :xm-silica)
 
 (defmethod make-pane-class ((framem openlook-frame-manager) class &rest options) 
   (declare (ignore options))
-  (second (assoc class '((scroll-bar openlook-scrollbar)
+  (second (assoc class '((scroll-bar openlook-scroll-bar)
 			 (slider openlook-slider)
 			 (push-button openlook-push-button)
 			 (label-pane openlook-label-pane)
@@ -54,26 +54,26 @@
 
 ;;;;;;;;;;;;;;;;;;;;
 
-(defclass openlook-scrollbar (xt-leaf-pane
-			      scrollbar)
+(defclass openlook-scroll-bar (xt-leaf-pane
+			      scroll-bar)
 	  ())
 
 (defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port)
 						     (parent t)
-						     (sheet openlook-scrollbar))
+						     (sheet openlook-scroll-bar))
   (with-accessors ((orientation gadget-orientation)) sheet
-		  (values 'tk::scrollbar
+		  (values 'tk::scroll-bar
 			  (list :orientation orientation))))
 
-(defmethod (setf silica::scrollbar-size) (nv (sb openlook-scrollbar))
+(defmethod (setf silica::scroll-bar-size) (nv (sb openlook-scroll-bar))
   ;; (tk::set-values (sheet-direct-mirror sb) :slider-size nv)
   nv)
 
-(defmethod (setf silica::scrollbar-value) (nv (sb openlook-scrollbar))
+(defmethod (setf silica::scroll-bar-value) (nv (sb openlook-scroll-bar))
   (tk::set-values (sheet-direct-mirror sb) :slider-value nv)
   nv)
 
-(defmethod change-scrollbar-values ((sb openlook-scrollbar) &rest args 
+(defmethod change-scroll-bar-values ((sb openlook-scroll-bar) &rest args 
 				    &key slider-size value)
   (declare (ignore args))
   (tk::set-values
@@ -82,24 +82,24 @@
    :slider-value value))
 
 
-(defmethod add-sheet-callbacks ((port openlook-port) (sheet openlook-scrollbar) (widget t))
+(defmethod add-sheet-callbacks ((port openlook-port) (sheet openlook-scroll-bar) (widget t))
   (tk::add-callback widget
 		    :slider-moved
-		    'scrollbar-changed-callback-1
+		    'scroll-bar-changed-callback-1
 		    sheet))
 
-(defmethod scrollbar-changed-callback-1 ((widget t) (sheet openlook-scrollbar))
+(defmethod scroll-bar-changed-callback-1 ((widget t) (sheet openlook-scroll-bar))
   (multiple-value-bind
       (value size)
       (tk::get-values widget :slider-value :proportion-length)
-    (scrollbar-value-changed-callback
+    (scroll-bar-value-changed-callback
      sheet
      (gadget-client sheet)
      (gadget-id sheet)
      value
      size)))
 
-(defmethod compose-space ((m openlook-scrollbar) &key width height)
+(defmethod compose-space ((m openlook-scroll-bar) &key width height)
   (let ((x 16))
     (ecase (gadget-orientation m)
       (:vertical
@@ -152,7 +152,6 @@
 		    :resize-callback 'sheet-mirror-resized-callback
 		    sheet))
 
-
 (defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port)
 						     (parent t)
 						     (sheet openlook-top-level-sheet))
@@ -261,7 +260,6 @@
   (command-button-callback button nil frame item))
 
 
-
 ;;; Label pane
 
 (defclass openlook-label-pane (xt-leaf-pane silica::label-pane) 
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index 63a210b4..9ca10649 100644
--- a/tk-silica/xm-gadgets.lisp
+++ b/tk-silica/xm-gadgets.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-gadgets.lisp,v 1.20 92/04/10 14:27:50 cer Exp Locker: cer $
+;; $fiHeader: xm-gadgets.lisp,v 1.21 92/04/14 15:30:10 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -28,7 +28,7 @@
 			 ;; experiment
 			 (outlined-pane motif-frame-pane)
 			 ;;
-			 (scroll-bar motif-scrollbar)
+			 (scroll-bar motif-scroll-bar)
 			 (slider motif-slider)
 			 (push-button motif-push-button)
 			 (label-pane motif-label-pane)
@@ -251,59 +251,56 @@
 (defmethod compose-space ((m motif-slider) &key width height)
   (declare (ignore width height))
   (destructuring-bind
-      (label scrollbar) (tk::widget-children (sheet-direct-mirror m))
-    (declare (ignore scrollbar))
+      (label scroll-bar) (tk::widget-children (sheet-direct-mirror m))
+    (declare (ignore scroll-bar))
     (multiple-value-bind
 	(label-x label-y label-width label-height)
-	(and (gadget-label m)
-	     (tk::widget-best-geometry label))
+	(if (gadget-label m)
+	    (tk::widget-best-geometry label)
+	  (values nil nil 0 0))
       (declare (ignore label-x label-y))
       ;;-- We need to estimate the space requirements for the value if
       ;;-- that is shown
       (let ((fudge 16))
 	(ecase (gadget-orientation m)
 	  (:vertical
-	   (make-space-requirement :width (if (gadget-label m) ;
-					      (+ fudge label-width)
-					    fudge)
+	   (make-space-requirement :width (+ fudge label-width)
 				   :min-height fudge
 				   :height (max (* 2 fudge) label-height)
 				   :max-height +fill+))
 	  (:horizontal
-	   (make-space-requirement :height (if (gadget-label m) ;
-					       (+ fudge label-height)
-					     fudge)
+	   (make-space-requirement :height (+ fudge label-height)
 				   :min-width fudge
 				   :width (max (* 2 fudge) label-width)
 				   :max-width +fill+)))))))
 
-;;; Scrollbar
+;;; Scroll-Bar
 
 
-(defclass motif-scrollbar (xt-leaf-pane
-			   scrollbar)
+(defclass motif-scroll-bar (xt-leaf-pane
+			   scroll-bar)
 	  ())
 
 (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
 						     (parent t)
-						     (sheet motif-scrollbar))
+						     (sheet motif-scroll-bar))
   (with-accessors ((orientation gadget-orientation)) sheet
     ;;-- we should really decide what the min and max resources should be
     (values 'tk::xm-scroll-bar 
 	    (list :orientation orientation))))
 
-(defmethod (setf silica::scrollbar-size) (nv (sb motif-scrollbar))
+(defmethod (setf silica::scroll-bar-size) (nv (sb motif-scroll-bar))
   (tk::set-values (sheet-direct-mirror sb) :slider-size (floor nv))
   nv)
 
-(defmethod (setf silica::scrollbar-value) (nv (sb motif-scrollbar))
+(defmethod (setf silica::scroll-bar-value) (nv (sb motif-scroll-bar))
   (tk::set-values (sheet-direct-mirror sb) :value nv)
   nv)
 
 ;;;--- We should use the motif functions for getting and changing the
 ;;;--- values
 
-(defmethod change-scrollbar-values ((sb motif-scrollbar) &key slider-size value)
+(defmethod change-scroll-bar-values ((sb motif-scroll-bar) &key slider-size value)
   (let ((mirror (sheet-direct-mirror sb)))
     (multiple-value-bind
 	(smin smax) (silica::gadget-range* sb)
@@ -312,28 +309,28 @@
 	(tk::set-values
 	 mirror
 	 :slider-size 
-	 (integerize-coordinate
+	 (fix-coordinate
 	  (silica::compute-symmetric-value
 		       smin smax slider-size mmin mmax))
-	 :value (integerize-coordinate
+	 :value (fix-coordinate
 		 (silica::compute-symmetric-value
 		  smin smax value mmin mmax)))))))
 
 
-(defmethod add-sheet-callbacks ((port motif-port) (sheet motif-scrollbar) (widget t))
+(defmethod add-sheet-callbacks ((port motif-port) (sheet motif-scroll-bar) (widget t))
   (tk::add-callback widget
 		    :value-changed-callback
-		    'scrollbar-changed-callback-1
+		    'scroll-bar-changed-callback-1
 		    sheet))
 
 
-(defun scrollbar-changed-callback-1 (widget sheet)
+(defun scroll-bar-changed-callback-1 (widget sheet)
   (multiple-value-bind
       (smin smax) (silica::gadget-range* sheet)
     (multiple-value-bind
 	(value size mmin mmax)
 	(tk::get-values widget :value :slider-size :minimum :maximum)
-      (scrollbar-value-changed-callback
+      (scroll-bar-value-changed-callback
        sheet
        (gadget-client sheet)
        (gadget-id sheet)
@@ -343,7 +340,7 @@
 	mmin mmax size smin smax)))))
 
 
-(defmethod compose-space ((m motif-scrollbar) &key width height)
+(defmethod compose-space ((m motif-scroll-bar) &key width height)
   (let ((x 16))
     (ecase (gadget-orientation m)
       (:vertical
@@ -357,14 +354,13 @@
 			       :width (* 2 x)
 			       :max-width +fill+)))))
 
-;; Should we stick in our preferred scrollbar geometry here?
+;; Should we stick in our preferred scroll-bar geometry here?
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
 (defclass motif-top-level-sheet (top-level-sheet) ())
 
-
 (defmethod add-sheet-callbacks :after ((port motif-port) 
 				       (sheet motif-top-level-sheet)
 				       (widget tk::xm-drawing-area))
@@ -466,7 +462,6 @@
 	    (getf initargs :y) (floor top))
     initargs))
 
-
 (defmethod compose-space ((te motif-text-editor) &key width height)
   (declare (ignore width height))
   (let ((sr (call-next-method)))
@@ -475,6 +470,7 @@
 	  (space-requirement-max-height sr) +fill+)
     sr))
 
+
 ;;; Toggle button
 
 (defclass motif-toggle-button (xt-leaf-pane 
@@ -515,7 +511,7 @@
 		    sheet))
 
 
-(defun scrollbar-changed-callback (widget which scroller)
+(defun scroll-bar-changed-callback (widget which scroller)
   (let* ((vp (sheet-child scroller))
 	 (viewport (viewport-viewport-region vp))
 	 (extent (stream-output-history (sheet-child vp))))
diff --git a/tk-silica/xm-silica.lisp b/tk-silica/xm-silica.lisp
index 67256b84..6235b73e 100644
--- a/tk-silica/xm-silica.lisp
+++ b/tk-silica/xm-silica.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-silica.lisp,v 1.12 92/04/03 12:04:54 cer Exp Locker: cer $
+;; $fiHeader: xm-silica.lisp,v 1.13 92/04/10 14:27:53 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
diff --git a/tk-silica/xt-frames.lisp b/tk-silica/xt-frames.lisp
index 3fa2ce7f..86dc1e50 100644
--- a/tk-silica/xt-frames.lisp
+++ b/tk-silica/xt-frames.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-frames.lisp,v 1.6 92/03/24 19:37:13 cer Exp Locker: cer $
+;; $fiHeader: xt-frames.lisp,v 1.7 92/04/10 14:27:56 cer Exp Locker: cer $
 
 
 (in-package :xm-silica)
@@ -33,34 +33,34 @@
 (defmethod frame-wrapper ((framem xt-frame-manager) 
 			  (frame standard-application-frame) pane)
   (declare (ignore pane))
-  (let ((menu-bar (slot-value frame 'menu-bar)))
-    (if menu-bar
-	(with-look-and-feel-realization (framem frame)
-	  (let ((mb (make-pane 'menu-bar
-			  :command-table (if (eq menu-bar t)
-					     (frame-command-table frame)
-					   (find-command-table
-					    menu-bar))))
-		(next (call-next-method))
-		(pointer
-		 (if (clim-internals::frame-pointer-documentationp frame)
-		     (setf (slot-value frame 'clim-internals::pointer-documentation-pane)
-		       (make-pane
-			'clim-internals::pointer-documentation-pane
-			:max-width +fill+
-			;;-- This should be a better value!
-			:height 15)))))
-	    (if pointer
-		(vertically () mb next pointer)
-	      (vertically () mb next))))
-	(call-next-method))))
+  (with-look-and-feel-realization (framem frame)
+    (let* ((menu-bar (slot-value frame 'menu-bar))
+	   (menu-bar-pane
+	     (and menu-bar
+		  (make-pane 'menu-bar
+			     :command-table (if (eq menu-bar t)
+						(frame-command-table frame)
+						(find-command-table menu-bar)))))
+	   (pointer-doc-pane
+	     ;;--- Don't like these forward references
+	     (and (clim-internals::frame-pointer-documentation-p frame)
+		  (setf (slot-value frame 'clim-internals::pointer-documentation-pane)
+			(make-pane
+			  'clim-internals::pointer-documentation-pane
+			  :max-width +fill+
+			  ;;--- This should be one line height in some text style
+			  :height 15))))
+	   (application-panes (call-next-method)))
+      (cond ((and menu-bar-pane pointer-doc-pane)
+	     (vertically () menu-bar-pane application-panes pointer-doc-pane))
+	    (menu-bar-pane
+	     (vertically () menu-bar-pane application-panes))
+	    (pointer-doc-pane
+	     (vertically () application-panes pointer-doc-pane))
+	    (t
+	     application-panes)))))
 
 
-(defmethod clim-internals::port-notify-user ((port xt-port) frame format-string &rest format-arguments)
-  (format excl::*initial-terminal-io* 
-	  "Notify ~a~%" 
-	  (list frame format-string format-arguments)))
-
 ;;;
 
 (defclass presentation-event (event)
@@ -87,3 +87,8 @@
 		   :sheet (frame-top-level-sheet frame)
 		   :value (second item))))
 
+(defmethod clim-internals::port-notify-user ((port xt-port) 
+					     frame format-string &rest format-arguments)
+  (format excl::*initial-terminal-io* 
+	  "Notify ~a~%" 
+	  (list frame format-string format-arguments)))
diff --git a/tk-silica/xt-gadgets.lisp b/tk-silica/xt-gadgets.lisp
index eda498c3..91b84420 100644
--- a/tk-silica/xt-gadgets.lisp
+++ b/tk-silica/xt-gadgets.lisp
@@ -20,21 +20,20 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-gadgets.lisp,v 1.8 92/04/03 12:04:56 cer Exp Locker: cer $
+;; $fiHeader: xt-gadgets.lisp,v 1.9 92/04/10 14:27:57 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
 (defclass ask-widget-for-size-mixin () ())
 
 (defmethod make-pane-1 ((framem xt-frame-manager)
-			   frame abstract-type &rest options)
+			frame abstract-type &rest options)
   (let ((type (apply #'make-pane-class framem abstract-type options)))
     (if type
 	(apply #'make-instance type 
 	       :frame frame
 	       :frame-manager framem
-	       (apply #'make-pane-arglist
-		      framem abstract-type options))
+	       (apply #'make-pane-arglist framem abstract-type options))
 	(call-next-method))))
 
 (defmethod compose-space ((pane ask-widget-for-size-mixin) &key width height)
@@ -131,6 +130,8 @@
 			ask-widget-for-size-mixin)
 	  ())
 
+;;--- This isn't really right.  Genera and CLX ports have kludges
+;;--- for the time being, too.
 (defmethod sheet-shell (sheet)
   (do ((w (sheet-mirror sheet) (tk::widget-parent w)))
       ((typep w '(or tk::shell null))
diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp
index 55a526f1..b111efc1 100644
--- a/tk-silica/xt-graphics.lisp
+++ b/tk-silica/xt-graphics.lisp
@@ -20,7 +20,7 @@ U;; -*- mode: common-lisp; package: xm-silica -*-
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-graphics.lisp,v 1.14 92/03/30 17:52:48 cer Exp Locker: cer $
+;; $fiHeader: xt-graphics.lisp,v 1.15 92/04/10 14:27:58 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -102,8 +102,7 @@ U;; -*- mode: common-lisp; package: xm-silica -*-
 (defun color-medium-p (medium)
   (and *use-color*
        (let ((display (port-display (port (medium-sheet medium)))))
-	 (> (x11:xdefaultdepth display
-			       (tk::display-screen-number display)) 2))))
+	 (> (x11:xdefaultdepth display (tk::display-screen-number display)) 2))))
 
 (defun recompute-gcs (medium)
   (with-slots 
@@ -342,21 +341,15 @@ U;; -*- mode: common-lisp; package: xm-silica -*-
       (unless (eq mcr +everywhere+)
 	(setq mcr (transform-region (sheet-device-transformation sheet) mcr))
 	(setq dr (region-intersection dr (bounding-rectangle mcr))))
-      (cond ((or #+ignore t (eq dr +everywhere+))
-	     (setf (tk::gcontext-clip-mask gc) 
-	       :none))
+      (cond ((eq dr +everywhere+)
+	     (setf (tk::gcontext-clip-mask gc) :none))
 	    ((eq dr +nowhere+)
-	     (setf (tk::gcontext-clip-mask gc) 
-	       :nowhere))
+	     (setf (tk::gcontext-clip-mask gc) :nowhere))
 	    (t
-	     (with-bounding-rectangle*
-		 (a b c d) dr
-		 (with-stack-list (x 
-				   (integerize-coordinate a) 
-				   (integerize-coordinate b) 
-				   (integerize-coordinate (- c a)) 
-				   (integerize-coordinate (- d b)))
-		   (setf (tk::gcontext-clip-mask gc) x))))))
+	     (with-bounding-rectangle* (a b c d) dr
+	       (with-stack-list (x (fix-coordinate a) (fix-coordinate b) 
+				   (fix-coordinate (- c a)) (fix-coordinate (- d b)))
+		 (setf (tk::gcontext-clip-mask gc) x))))))
     
     (when (eq (tk::gcontext-fill-style gc) :tiled)
       (setf (tk::gcontext-ts-x-origin gc) x-origin
@@ -489,7 +482,7 @@ U;; -*- mode: common-lisp; package: xm-silica -*-
 			      (incf npoints))
 			     (t npoints)))))
 	 (window (medium-drawable medium))
-	 ;;--- is this right
+	 ;; These really are fixnums, since we're fixing coordinates below
 	 (minx most-positive-fixnum)
 	 (miny most-positive-fixnum))
     (do ((ps list-of-x-and-ys (cddr ps))
@@ -513,10 +506,10 @@ U;; -*- mode: common-lisp; package: xm-silica -*-
 	   (tk::object-display window)
 	   window
 	   (adjust-ink medium
-					      (decode-ink (medium-ink medium) medium)
-					      (medium-ink medium)
-					      (medium-line-style medium)
-					      minx miny)
+		       (decode-ink (medium-ink medium) medium)
+		       (medium-ink medium)
+		       (medium-line-style medium)
+		       minx miny)
 	   points
 	   npoints
 	   x11:complex
@@ -525,10 +518,10 @@ U;; -*- mode: common-lisp; package: xm-silica -*-
 	  (tk::object-display window)
 	  window
 	  (adjust-ink medium
-					 (decode-ink (medium-ink medium) medium)
-					 (medium-ink medium)
-					 (medium-line-style medium)
-					 minx miny)
+		      (decode-ink (medium-ink medium) medium)
+		      (medium-ink medium)
+		      (medium-line-style medium)
+		      minx miny)
 	  points
 	  npoints
 	  x11:coordmodeorigin)))))
diff --git a/tk-silica/xt-pixmaps.lisp b/tk-silica/xt-pixmaps.lisp
index 0600ef4a..0560b773 100644
--- a/tk-silica/xt-pixmaps.lisp
+++ b/tk-silica/xt-pixmaps.lisp
@@ -20,15 +20,14 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-pixmaps.lisp,v 1.3 92/02/24 13:06:28 cer Exp $
+;; $fiHeader: xt-pixmaps.lisp,v 1.4 92/03/04 16:20:45 cer Exp Locker: cer $
 
 
 (in-package :xm-silica)
 
 (defmethod port-allocate-pixmap ((port xt-port) sheet width height)
   (declare (ignore sheet))
-  (assert (integerp width))
-  (assert (integerp height))
+  (fix-coordinates width height)
   (let ((root (tk::display-root-window (port-display port))))
     (make-instance 'tk::pixmap
       :drawable root
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index 2093e51b..61e3e7b7 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.17 92/04/03 12:04:58 cer Exp Locker: cer $
+;; $fiHeader: xt-silica.lisp,v 1.18 92/04/10 14:27:59 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -37,7 +37,6 @@
   (:default-initargs :allow-loose-text-style-size-mapping t)
   (:documentation "The port for X intrinsics based ports"))
 
-
 (defmethod port-copy-gc ((port xt-port))
   (with-slots (copy-gc display) port
     (or copy-gc
@@ -46,7 +45,6 @@
 			 :display display
 			 :foreign-address (x11:screen-default-gc (x11:xdefaultscreenofdisplay (port-display port))))))))
 
-
 (defmacro destructure-x-server-path ((&key display) path &body body)
   ;;-- Of course the port ends up with an unspecified server-path.
   ;;-- Perhaps this is OK or perhaps we have to default the components before
@@ -70,11 +68,11 @@
 	    (slot-value port 'display) display)
       (initialize-xlib-port port display))))
 
-(defvar *clx-font-families* '((:fix "*-*-courier-*-*-*-*-*-*-*-*-*-*-*-*")
-			      (:sans-serif "*-*-helvetica-*-*-*-*-*-*-*-*-*-*-*-*")
-			      (:serif "*-*-charter-*-*-*-*-*-*-*-*-*-*-*-*"
-			       "*-*-new century schoolbook-*-*-*-*-*-*-*-*-*-*-*-*"
-			       "*-*-times-*-*-*-*-*-*-*-*-*-*-*-*")))
+(defvar *xt-font-families* '((:fix "*-*-courier-*-*-*-*-*-*-*-*-*-*-*-*")
+			     (:sans-serif "*-*-helvetica-*-*-*-*-*-*-*-*-*-*-*-*")
+			     (:serif "*-*-charter-*-*-*-*-*-*-*-*-*-*-*-*"
+			      "*-*-new century schoolbook-*-*-*-*-*-*-*-*-*-*-*-*"
+			      "*-*-times-*-*-*-*-*-*-*-*-*-*-*-*")))
 
 (defun disassemble-x-font-name (name)
   (let ((cpos 0)
@@ -90,7 +88,7 @@
     (reverse tokens)))
 
 
-(defvar *clx-fallback-font* "8x13"
+(defvar *xt-fallback-font* "8x13"
   "When non NIL and nothing better exists use this as the fallback font")
 
 (defmethod initialize-xlib-port (port display)
@@ -109,7 +107,7 @@
 		  (point-size (float designed-point-size))
 		  (size (/ point-size 10)))
 	     (make-text-style family face size))))
-    (dolist (family-stuff *clx-font-families*)
+    (dolist (family-stuff *xt-font-families*)
       (let ((family (car family-stuff)))
 	(dolist (font-pattern (cdr family-stuff))
 	  (dolist (xfont (tk::list-font-names display font-pattern))
@@ -123,22 +121,22 @@
 	))
     (let (temp)
       (cond ((setq temp
-		   (dolist (family *clx-font-families*)
+		   (dolist (family *xt-font-families*)
 		     (when (text-style-mapping-exists-p port `(,(car family) :roman 10))
 		       (return (make-text-style (car family) :roman 10)))))
 	     (setf (text-style-mapping port (port-undefined-text-style port)) temp))
 	    ;; Perhaps we should look for some other conveniently sized
 	    ;; fonts.
-	    (*clx-fallback-font*
+	    (*xt-fallback-font*
 	     (setf (text-style-mapping port (port-undefined-text-style port))
 		   (make-instance 'tk::font 
 				  :display display
-				  :name *clx-fallback-font*)))
+				  :name *xt-fallback-font*)))
 	    ;;; Perhaps we should just grab the first font we can find.
 	    (t
 	     (error "Unable to determine default font"))))))
 
-(defparameter *clx-logical-size-alist*
+(defparameter *xt-logical-size-alist*
 	      '((:tiny       6)
 		(:very-small 8)
 		(:small	     10)
@@ -150,13 +148,12 @@
 (defmethod standardize-text-style ((port xt-port) style
 				   &optional (character-set *standard-character-set*))
   (standardize-text-style-1
-    port style character-set *clx-logical-size-alist*))
+    port style character-set *xt-logical-size-alist*))
 
 
 (defmethod destroy-mirror ((port xt-port) sheet)
   ;;-- I dont think that we should do this.
-  (tk::destroy-widget (sheet-direct-mirror sheet))
-  )
+  (tk::destroy-widget (sheet-direct-mirror sheet)))
 
 (defmethod realize-mirror ((port xt-port) sheet)
   (let ((parent (find-widget-parent port sheet)))
@@ -197,27 +194,25 @@
 		 sheet)
 		nil)
 	       (:key-press
-		(multiple-value-bind
-		    (character keysym)
+		(multiple-value-bind (character keysym)
 		    (lookup-character-and-keysym sheet widget event)
 		  (make-instance 'key-press-event
 				 :key-name keysym
 				 :character character
 				 :sheet sheet
-				 :modifiers 
+				 :modifiers
 				 (state->modifiers
 				  (x11::xkeyevent-state event)
 				  nil))))
     
 	       (:key-release
-		(multiple-value-bind
-		    (character keysym)
+		(multiple-value-bind (character keysym)
 		    (lookup-character-and-keysym sheet widget event)
 		  (make-instance 'key-release-event
 				 :key-name keysym
 				 :character character
 				 :sheet sheet
-				 :modifiers
+				 :modifiers 
 				 (state->modifiers
 				  (x11::xkeyevent-state event)
 				  nil))))
@@ -253,25 +248,25 @@
 			       :button (x-button->silica-button button)
 			       :modifiers
 			       (state->modifiers
-				modifiers)
+				(x11::xkeyevent-state event))
 			       :sheet sheet))
 	       (:enter-notify
 		(make-instance 'pointer-enter-event
 			       :native-x native-x
 			       :native-y native-y
 			       :button (x-button->silica-button button)
-			       :modifiers
+			       :modifiers 
 			       (state->modifiers
-				modifiers)
+				(x11::xkeyevent-state event))
 			       :sheet sheet))
 	       (:motion-notify
 		(make-instance 'pointer-motion-event
 			       :native-x native-x
 			       :native-y native-y
 			       :button (x-button->silica-button button)
-			       :modifiers
+			       :modifiers 
 			       (state->modifiers
-				modifiers)
+				(x11::xkeyevent-state event))
 			       :sheet sheet)))))
 	(when clim-event
 	  (distribute-event
@@ -320,31 +315,29 @@
     (:key-press
       (distribute-event
 	(port sheet)
-	(multiple-value-bind
-		    (character keysym)
-		    (lookup-character-and-keysym sheet widget event)
-		  (make-instance 'key-press-event
-				 :key-name keysym
-				 :character character
-				 :sheet sheet
-				 :modifiers
-				 (state->modifiers
-				  (x11::xkeyevent-state event)
-				  nil)))))
+	(multiple-value-bind (character keysym)
+	    (lookup-character-and-keysym sheet widget event)
+	  (make-instance 'key-press-event
+			 :key-name keysym
+			 :character character
+			 :sheet sheet
+			 :modifiers
+			 (state->modifiers
+			  (x11::xkeyevent-state event)
+			  nil)))))
     (:key-release
-     (distribute-event
-      (port sheet)
-      (multiple-value-bind
-	  (character keysym)
-	  (lookup-character-and-keysym sheet widget event)
-	(make-instance 'key-release-event
-		       :key-name keysym
-		       :character character
-		       :sheet sheet
-		       :modifiers
-		       (state->modifiers
-			(x11::xkeyevent-state event)
-			nil)))))
+      (distribute-event
+	(port sheet)
+	(multiple-value-bind (character keysym)
+	    (lookup-character-and-keysym sheet widget event)
+	  (make-instance 'key-release-event
+			 :key-name keysym
+			 :character character
+			 :sheet sheet
+			 :modifiers
+			 (state->modifiers
+			  (x11::xkeyevent-state event)
+			  nil)))))
     (:button-press
       (distribute-event
 	(port sheet)
@@ -352,7 +345,7 @@
 		       :sheet sheet
 		       :x :??
 		       :y :??
-		       :modifiers
+		       :modifiers 
 		       (state->modifiers
 			(x11::xkeyevent-state event))
 		       :button (x-button->silica-button 
@@ -397,10 +390,10 @@
       ;;--- We do not want to specify the x,y if this is a top-level
       ;;sheet.
       (unless (typep parent 'tk::shell)
-	(setf (getf initargs :x) (integerize-coordinate left)
-	      (getf initargs :y) (integerize-coordinate top)))
-      (setf (getf initargs :width) (integerize-coordinate (- right left))
-	    (getf initargs :height) (integerize-coordinate (- bottom top)))))
+	(setf (getf initargs :x) (fix-coordinate left)
+	      (getf initargs :y) (fix-coordinate top)))
+      (setf (getf initargs :width)  (fix-coordinate (- right left))
+	    (getf initargs :height) (fix-coordinate (- bottom top)))))
   initargs)
 
 ;; If we are creating a top level sheet then we have to create a shell for it
@@ -518,10 +511,10 @@
 				    target-right target-bottom)
   (let ((w (- target-right  target-left))
 	(h (- target-bottom target-top)))
-    (setf target-left (integerize-coordinate target-left)
-	  target-top (integerize-coordinate target-top)
-	  w (integerize-coordinate w)
-	  h (integerize-coordinate h))
+    (setf target-left (fix-coordinate target-left)
+	  target-top  (fix-coordinate target-top)
+	  w (fix-coordinate w)
+	  h (fix-coordinate h))
     (change-widget-geometry
      ;;--- For top level sheets the sheet-parent is the graft whose
      ;; mirror is the application shell
@@ -621,176 +614,173 @@
     (and frame
 	 (popup-frame-p frame))))
 
-;;; Keysym stuff
 
-(defvar *clx-keysym->clim-keysym-table*
-    (make-hash-table))
+;;; Keysym stuff
 
-(defvar *clim-keysym->clx-keysym-table* (make-hash-table))
+(defvar *xt-keysym->clim-keysym-table* (make-hash-table))
+(defvar *clim-keysym->xt-keysym-table* (make-hash-table))
 
-(defmacro define-clx-keysym (clx-keysym clim-keysym)
+(defmacro define-xt-keysym (xt-keysym clim-keysym)
   `(progn 
-     (setf (gethash ,clx-keysym *clx-keysym->clim-keysym-table*) ',clim-keysym)
-     (unless (gethash ,clim-keysym *clim-keysym->clx-keysym-table*)
-       (setf (gethash ,clim-keysym *clim-keysym->clx-keysym-table*) ',clx-keysym))))
+     (setf (gethash ,xt-keysym *xt-keysym->clim-keysym-table*) ',clim-keysym)
+     (unless (gethash ,clim-keysym *clim-keysym->xt-keysym-table*)
+       (setf (gethash ,clim-keysym *clim-keysym->xt-keysym-table*) ',xt-keysym))))
 
-(defun-inline clx-keysym->keysym (clx-keysym)
-  (gethash clx-keysym *clx-keysym->clim-keysym-table*))
+(defun-inline xt-keysym->keysym (xt-keysym)
+  (gethash xt-keysym *xt-keysym->clim-keysym-table*))
 
-(defun-inline keysym->clx-keysym (keysym)
-  (gethash keysym *clim-keysym->clx-keysym-table*))
+(defun-inline keysym->xt-keysym (keysym)
+  (gethash keysym *clim-keysym->xt-keysym-table*))
 
 ;; The standard characters
-(define-clx-keysym 032 :space)
-(define-clx-keysym 033 :\!)
-(define-clx-keysym 034 :\")
-(define-clx-keysym 035 :\#)
-(define-clx-keysym 036 :\$)
-(define-clx-keysym 037 :\%)
-(define-clx-keysym 038 :\&)
-(define-clx-keysym 039 :\')
-(define-clx-keysym 040 :\()
-(define-clx-keysym 041 :\))
-(define-clx-keysym 042 :\*)
-(define-clx-keysym 043 :\+)
-(define-clx-keysym 044 :\,)
-(define-clx-keysym 045 :\-)
-(define-clx-keysym 046 :\.)
-(define-clx-keysym 047 :\/)
-(define-clx-keysym 048 :\0)
-(define-clx-keysym 049 :\1)
-(define-clx-keysym 050 :\2)
-(define-clx-keysym 051 :\3)
-(define-clx-keysym 052 :\4)
-(define-clx-keysym 053 :\5)
-(define-clx-keysym 054 :\6)
-(define-clx-keysym 055 :\7)
-(define-clx-keysym 056 :\8)
-(define-clx-keysym 057 :\9)
-(define-clx-keysym 058 :\:)
-(define-clx-keysym 059 :\;)
-(define-clx-keysym 060 :\<)
-(define-clx-keysym 061 :\=)
-(define-clx-keysym 062 :\>)
-(define-clx-keysym 063 :\?)
-(define-clx-keysym 064 :\@)
-(define-clx-keysym 065 :\A)
-(define-clx-keysym 097 :\A)
-(define-clx-keysym 066 :\B)
-(define-clx-keysym 098 :\B)
-(define-clx-keysym 067 :\C)
-(define-clx-keysym 099 :\C)
-(define-clx-keysym 068 :\D)
-(define-clx-keysym 100 :\D)
-(define-clx-keysym 069 :\E)
-(define-clx-keysym 101 :\E)
-(define-clx-keysym 070 :\F)
-(define-clx-keysym 102 :\F)
-(define-clx-keysym 071 :\G)
-(define-clx-keysym 103 :\G)
-(define-clx-keysym 072 :\H)
-(define-clx-keysym 104 :\H)
-(define-clx-keysym 073 :\I)
-(define-clx-keysym 105 :\I)
-(define-clx-keysym 074 :\J)
-(define-clx-keysym 106 :\J)
-(define-clx-keysym 075 :\K)
-(define-clx-keysym 107 :\K)
-(define-clx-keysym 076 :\L)
-(define-clx-keysym 108 :\L)
-(define-clx-keysym 077 :\M)
-(define-clx-keysym 109 :\M)
-(define-clx-keysym 078 :\N)
-(define-clx-keysym 110 :\N)
-(define-clx-keysym 079 :\O)
-(define-clx-keysym 111 :\O)
-(define-clx-keysym 080 :\P)
-(define-clx-keysym 112 :\P)
-(define-clx-keysym 081 :\Q)
-(define-clx-keysym 113 :\Q)
-(define-clx-keysym 082 :\R)
-(define-clx-keysym 114 :\R)
-(define-clx-keysym 083 :\S)
-(define-clx-keysym 115 :\S)
-(define-clx-keysym 084 :\T)
-(define-clx-keysym 116 :\T)
-(define-clx-keysym 085 :\U)
-(define-clx-keysym 117 :\U)
-(define-clx-keysym 086 :\V)
-(define-clx-keysym 118 :\V)
-(define-clx-keysym 087 :\W)
-(define-clx-keysym 119 :\W)
-(define-clx-keysym 088 :\X)
-(define-clx-keysym 120 :\X)
-(define-clx-keysym 089 :\Y)
-(define-clx-keysym 121 :\Y)
-(define-clx-keysym 090 :\Z)
-(define-clx-keysym 122 :\Z)
-(define-clx-keysym 091 :\[)
-(define-clx-keysym 092 :\\)
-(define-clx-keysym 093 :\])
-(define-clx-keysym 094 :\^)
-(define-clx-keysym 095 :\_)
-(define-clx-keysym 096 :\`)
-(define-clx-keysym 123 :\{)
-(define-clx-keysym 124 :\|)
-(define-clx-keysym 125 :\})
-(define-clx-keysym 126 :\~)
+(define-xt-keysym 032 :space)
+(define-xt-keysym 033 :\!)
+(define-xt-keysym 034 :\")
+(define-xt-keysym 035 :\#)
+(define-xt-keysym 036 :\$)
+(define-xt-keysym 037 :\%)
+(define-xt-keysym 038 :\&)
+(define-xt-keysym 039 :\')
+(define-xt-keysym 040 :\()
+(define-xt-keysym 041 :\))
+(define-xt-keysym 042 :\*)
+(define-xt-keysym 043 :\+)
+(define-xt-keysym 044 :\,)
+(define-xt-keysym 045 :\-)
+(define-xt-keysym 046 :\.)
+(define-xt-keysym 047 :\/)
+(define-xt-keysym 048 :\0)
+(define-xt-keysym 049 :\1)
+(define-xt-keysym 050 :\2)
+(define-xt-keysym 051 :\3)
+(define-xt-keysym 052 :\4)
+(define-xt-keysym 053 :\5)
+(define-xt-keysym 054 :\6)
+(define-xt-keysym 055 :\7)
+(define-xt-keysym 056 :\8)
+(define-xt-keysym 057 :\9)
+(define-xt-keysym 058 :\:)
+(define-xt-keysym 059 :\;)
+(define-xt-keysym 060 :\<)
+(define-xt-keysym 061 :\=)
+(define-xt-keysym 062 :\>)
+(define-xt-keysym 063 :\?)
+(define-xt-keysym 064 :\@)
+(define-xt-keysym 065 :\A)
+(define-xt-keysym 097 :\A)
+(define-xt-keysym 066 :\B)
+(define-xt-keysym 098 :\B)
+(define-xt-keysym 067 :\C)
+(define-xt-keysym 099 :\C)
+(define-xt-keysym 068 :\D)
+(define-xt-keysym 100 :\D)
+(define-xt-keysym 069 :\E)
+(define-xt-keysym 101 :\E)
+(define-xt-keysym 070 :\F)
+(define-xt-keysym 102 :\F)
+(define-xt-keysym 071 :\G)
+(define-xt-keysym 103 :\G)
+(define-xt-keysym 072 :\H)
+(define-xt-keysym 104 :\H)
+(define-xt-keysym 073 :\I)
+(define-xt-keysym 105 :\I)
+(define-xt-keysym 074 :\J)
+(define-xt-keysym 106 :\J)
+(define-xt-keysym 075 :\K)
+(define-xt-keysym 107 :\K)
+(define-xt-keysym 076 :\L)
+(define-xt-keysym 108 :\L)
+(define-xt-keysym 077 :\M)
+(define-xt-keysym 109 :\M)
+(define-xt-keysym 078 :\N)
+(define-xt-keysym 110 :\N)
+(define-xt-keysym 079 :\O)
+(define-xt-keysym 111 :\O)
+(define-xt-keysym 080 :\P)
+(define-xt-keysym 112 :\P)
+(define-xt-keysym 081 :\Q)
+(define-xt-keysym 113 :\Q)
+(define-xt-keysym 082 :\R)
+(define-xt-keysym 114 :\R)
+(define-xt-keysym 083 :\S)
+(define-xt-keysym 115 :\S)
+(define-xt-keysym 084 :\T)
+(define-xt-keysym 116 :\T)
+(define-xt-keysym 085 :\U)
+(define-xt-keysym 117 :\U)
+(define-xt-keysym 086 :\V)
+(define-xt-keysym 118 :\V)
+(define-xt-keysym 087 :\W)
+(define-xt-keysym 119 :\W)
+(define-xt-keysym 088 :\X)
+(define-xt-keysym 120 :\X)
+(define-xt-keysym 089 :\Y)
+(define-xt-keysym 121 :\Y)
+(define-xt-keysym 090 :\Z)
+(define-xt-keysym 122 :\Z)
+(define-xt-keysym 091 :\[)
+(define-xt-keysym 092 :\\)
+(define-xt-keysym 093 :\])
+(define-xt-keysym 094 :\^)
+(define-xt-keysym 095 :\_)
+(define-xt-keysym 096 :\`)
+(define-xt-keysym 123 :\{)
+(define-xt-keysym 124 :\|)
+(define-xt-keysym 125 :\})
+(define-xt-keysym 126 :\~)
 
 ;; The semi-standard characters
-
-
 (defmacro keysym (b &rest more)
   (dolist (n more)
     (setq b (+ (ash b 8) n)))
   b)
 
-(define-clx-keysym (keysym 255 013) :return)
-(define-clx-keysym (keysym 255 009) :tab)
-(define-clx-keysym (keysym 255 255) :rubout)
-(define-clx-keysym (keysym 255 008) :backspace)
-(define-clx-keysym (keysym 009 227) :page)
-(define-clx-keysym (keysym 255 010) :linefeed)
+(define-xt-keysym (keysym 255 013) :return)
+(define-xt-keysym (keysym 255 009) :tab)
+(define-xt-keysym (keysym 255 255) :rubout)
+(define-xt-keysym (keysym 255 008) :backspace)
+(define-xt-keysym (keysym 009 227) :page)
+(define-xt-keysym (keysym 255 010) :linefeed)
 
 ;; Other useful characters
-(define-clx-keysym (keysym 255 087) :end)
-(define-clx-keysym (keysym 255 105) :abort)
-(define-clx-keysym (keysym 255 106) :help)
-(define-clx-keysym (keysym 255 104) :complete)
-(define-clx-keysym (keysym 255 086) :scroll)
-(define-clx-keysym (keysym 255 097) :refresh)
-(define-clx-keysym (keysym 255 011) :clear-input)
+(define-xt-keysym (keysym 255 087) :end)
+(define-xt-keysym (keysym 255 105) :abort)
+(define-xt-keysym (keysym 255 106) :help)
+(define-xt-keysym (keysym 255 104) :complete)
+(define-xt-keysym (keysym 255 086) :scroll)
+(define-xt-keysym (keysym 255 097) :refresh)
+(define-xt-keysym (keysym 255 011) :clear-input)
 
 ;; Finally, the shifts
 ;; snarfed from translate.cl
 
-(defconstant left-shift-keysym (keysym 255 225))
+(defconstant left-shift-keysym  (keysym 255 225))
 (defconstant right-shift-keysym (keysym 255 226))
-(defconstant left-control-keysym (keysym 255 227))
+(defconstant left-control-keysym  (keysym 255 227))
 (defconstant right-control-keysym (keysym 255 228))
-(defconstant caps-lock-keysym (keysym 255 229))
+(defconstant caps-lock-keysym  (keysym 255 229))
 (defconstant shift-lock-keysym (keysym 255 230))
-(defconstant left-meta-keysym (keysym 255 231))
+(defconstant left-meta-keysym  (keysym 255 231))
 (defconstant right-meta-keysym (keysym 255 232))
-(defconstant left-alt-keysym (keysym 255 233))
+(defconstant left-alt-keysym  (keysym 255 233))
 (defconstant right-alt-keysym (keysym 255 234))
-(defconstant left-super-keysym (keysym 255 235))
+(defconstant left-super-keysym  (keysym 255 235))
 (defconstant right-super-keysym (keysym 255 236))
-(defconstant left-hyper-keysym (keysym 255 237))
+(defconstant left-hyper-keysym  (keysym 255 237))
 (defconstant right-hyper-keysym (keysym 255 238))
 
-(define-clx-keysym left-shift-keysym :left-shift)
-(define-clx-keysym right-shift-keysym :right-shift)
-(define-clx-keysym left-control-keysym :left-control)
-(define-clx-keysym right-control-keysym :right-control)
-(define-clx-keysym caps-lock-keysym :caps-lock)
-(define-clx-keysym shift-lock-keysym :shift-lock)
-(define-clx-keysym left-meta-keysym :left-meta)
-(define-clx-keysym right-meta-keysym :right-meta)
-(define-clx-keysym left-super-keysym :left-super)
-(define-clx-keysym right-super-keysym :right-super)
-(define-clx-keysym left-hyper-keysym :left-hyper)
-(define-clx-keysym right-hyper-keysym :right-hyper)
+(define-xt-keysym left-shift-keysym  :left-shift)
+(define-xt-keysym right-shift-keysym :right-shift)
+(define-xt-keysym left-control-keysym  :left-control)
+(define-xt-keysym right-control-keysym :right-control)
+(define-xt-keysym caps-lock-keysym  :caps-lock)
+(define-xt-keysym shift-lock-keysym :shift-lock)
+(define-xt-keysym left-meta-keysym  :left-meta)
+(define-xt-keysym right-meta-keysym :right-meta)
+(define-xt-keysym left-super-keysym  :left-super)
+(define-xt-keysym right-super-keysym :right-super)
+(define-xt-keysym left-hyper-keysym  :left-hyper)
+(define-xt-keysym right-hyper-keysym :right-hyper)
 
 (defun lookup-character-and-keysym (sheet mirror event)
   (declare (ignore sheet mirror))
@@ -829,18 +819,13 @@
 			      cltl1:char-control-bit 0)
 			  (if (logtest x +meta-key+)
 			      cltl1:char-meta-bit 0))))))
-    (values character
-	    (clx-keysym->keysym keysym))))
+    (values character (xt-keysym->keysym keysym))))
 
 
-(defun state->modifiers (x &optional (shiftit t))
+(defun state->modifiers (x &optional (shift-it t))
   (logior
-   (if (and shiftit (logtest x x11:shiftmask)) +shift-key+ 0)
-   (if (logtest x x11:controlmask) +control-key+ 0)
-   (if (logtest x x11:mod1mask) +meta-key+ 0)
-   (if (logtest x x11:mod2mask) +super-key+ 0)
-   (if (logtest x x11:mod3mask) +hyper-key+ 0)))
-
-
-
-
+    (if (and shift-it (logtest x x11:shiftmask)) +shift-key+ 0)
+    (if (logtest x x11:controlmask) +control-key+ 0)
+    (if (logtest x x11:mod1mask) +meta-key+ 0)
+    (if (logtest x x11:mod2mask) +super-key+ 0)
+    (if (logtest x x11:mod3mask) +hyper-key+ 0)))
diff --git a/tk/event.lisp b/tk/event.lisp
index 6dbb8f82..759f10f9 100644
--- a/tk/event.lisp
+++ b/tk/event.lisp
@@ -20,11 +20,10 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: event.lisp,v 1.6 92/03/09 17:40:35 cer Exp Locker: cer $
+;; $fiHeader: event.lisp,v 1.7 92/03/30 17:51:31 cer Exp $
 
 (in-package :tk)
 
-
 (defun simple-event-loop (context)
   (loop 
       (process-one-event context)))
@@ -74,8 +73,6 @@
 (defun app-process-event (context mask)
   (app_process_event context mask))
 
-
-
 (defvar *event* nil)
 
 (defun-c-callable event-handler ((widget :unsigned-long)
diff --git a/tk/font.lisp b/tk/font.lisp
index 8fe7aa43..e936c9cc 100644
--- a/tk/font.lisp
+++ b/tk/font.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: font.lisp,v 1.7 92/03/09 17:40:39 cer Exp $
+;; $fiHeader: font.lisp,v 1.8 92/03/30 17:51:32 cer Exp $
 
 (in-package :tk)
 
@@ -36,7 +36,7 @@
     (let ((x (x11:xloadqueryfont display name)))
       (when (zerop x) (error "Cannot find font: ~S" name))
       (setf (foreign-pointer-address f) x)
-      (register-address f x))))
+      (register-address f))))
 
 
 (defun query-font (display font-id)
diff --git a/tk/foreign.lisp b/tk/foreign.lisp
index e59353d3..d5ffe848 100644
--- a/tk/foreign.lisp
+++ b/tk/foreign.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: foreign.lisp,v 1.7 92/03/30 17:51:33 cer Exp Locker: cer $
+;; $fiHeader: foreign.lisp,v 1.8 92/04/03 12:03:57 cer Exp Locker: cer $
 
 (in-package :tk)
 
@@ -86,5 +86,3 @@
   (setf (foreign-pointer-address d)
     (or display
 	(apply #'open-display args))))
-
-
diff --git a/tk/gcontext.lisp b/tk/gcontext.lisp
index 6f690ccd..9765f84a 100644
--- a/tk/gcontext.lisp
+++ b/tk/gcontext.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: gcontext.lisp,v 1.8 92/03/09 17:40:43 cer Exp $
+;; $fiHeader: gcontext.lisp,v 1.9 92/03/30 17:51:35 cer Exp $
 
 (in-package :tk)
 
@@ -78,7 +78,6 @@
 
 (defclass gcontext (display-object)
   ())
-	  
 
 
 (defmethod initialize-instance :after ((gcontext gcontext)
@@ -93,6 +92,7 @@
 				       exposures clip-x clip-y
 				       clip-mask clip-ordering 
 				       dash-offset dashes)
+
   (unless foreign-address
     (setf foreign-address (x11::xcreategc display drawable 0 0)
 	  (foreign-pointer-address gcontext) foreign-address
diff --git a/tk/graphics.lisp b/tk/graphics.lisp
index a59ed0e2..8472c13a 100644
--- a/tk/graphics.lisp
+++ b/tk/graphics.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: graphics.lisp,v 1.5 92/03/09 17:40:45 cer Exp Locker: cer $
+;; $fiHeader: graphics.lisp,v 1.6 92/03/24 19:36:10 cer Exp $
 
 (in-package :tk)
 
@@ -99,8 +99,7 @@
        (- center-y y-radius)
        (* 2 x-radius)
        (* 2 y-radius)
-       start-angle 
-       end-angle))))
+       start-angle end-angle))))
 
 (defstub draw-lines (drawable gcontext points &key relative-p fill-p
 			    (shape :complex))
@@ -190,7 +189,6 @@
 (defun draw-string (drawable gc x y string &optional (start 0) end)
   (unless start (setq start 0))
   (unless end (setq end (length string)))
-  #-ignore
   (x11::xdrawstring
    (object-display drawable)
    drawable
diff --git a/tk/make-classes.lisp b/tk/make-classes.lisp
index dd26be3f..5458a634 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.11 92/03/30 17:51:42 cer Exp Locker: cer $
+;; $fiHeader: make-classes.lisp,v 1.12 92/04/03 12:04:03 cer Exp Locker: cer $
 
 (in-package :tk)
 
@@ -82,6 +82,7 @@
 (defmethod widget-display ((object xt-root-class))
   (object-display object))
 
+
 (defclass rect (xt-root-class) ())
 (defclass un-named-obj (rect) ())
 
@@ -159,7 +160,7 @@
 		:resources all-resources
 		:constraints  all-constraints
 		:entry-point class-ep
-		:foreign-address (get-foreign-variable-value class-ep))))
+		:foreign-address  (get-foreign-variable-value class-ep))))
 	  (register-address class)
 	  (add-accessors-for-toolkit-class class)
 	  (push class r)))))))
@@ -245,7 +246,7 @@
 
 
 (defun-c-callable toolkit-error-handler ((message :unsigned-long))
-  (error "toolkit errror: ~a" (char*-to-string message)))
+  (error "toolkit error: ~a" (char*-to-string message)))
 
 (defun-c-callable toolkit-warning-handler ((message :unsigned-long))
   (let ((*error-output* excl:*initial-terminal-io*))
diff --git a/tk/ol-examples.lisp b/tk/ol-examples.lisp
index ee732d4d..ef1c6af4 100644
--- a/tk/ol-examples.lisp
+++ b/tk/ol-examples.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-examples.lisp,v 1.4 92/01/31 14:55:03 cer Exp $
+;; $fiHeader: ol-examples.lisp,v 1.5 92/02/24 13:03:40 cer Exp Locker: cer $
 
 (in-package :tk)
 
@@ -52,7 +52,7 @@
 			      :height 100
 			      :parent control))
   
-  (setq scrollbar (make-instance 'scrollbar
+  (setq scroll-bar (make-instance 'scroll-bar
 				 :orientation :horizontal
 				 :height 100
 				 :parent control))
diff --git a/tk/resources.lisp b/tk/resources.lisp
index f9e77af7..c80a7551 100644
--- a/tk/resources.lisp
+++ b/tk/resources.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: resources.lisp,v 1.13 92/04/03 12:04:06 cer Exp Locker: cer $
+;; $fiHeader: resources.lisp,v 1.14 92/04/10 14:26:17 cer Exp Locker: cer $
 
 (in-package :tk)
 
@@ -34,8 +34,6 @@
        (elt ',elements value))))
 
 
-
-
 (defun set-values (widget &rest values)
   (let ((arglist (make-arglist-for-class (class-of widget) widget values)))
     (set_values widget
@@ -63,6 +61,11 @@
 	(push (convert-resource-out parent (resource-type resource) value)
 	      new-args)))))
 
+
+(defmethod convert-resource-out (parent type value)
+  (cerror "Try again" "cannot convert-out resource for ~S,~S,~S" parent type value)
+  (convert-resource-out parent type value))
+
 (defmethod convert-resource-out :around (parent type value)
   (declare (optimize (speed 3))
 	   (ignore parent type value))
@@ -71,11 +74,6 @@
 	result
       (ff:foreign-pointer-address result))))
 
-(defmethod convert-resource-out (parent type value)
-  (cerror "Try again" "cannot convert-out resource for ~S,~S,~S" parent type value)
-  (convert-resource-out parent type value))
-
-
 (defmethod convert-resource-out ((parent t) (type (eql 'xm-string)) value)
   (string_create_l_to_r (string-to-char* value) (string-to-char* "")))
 
@@ -84,8 +82,6 @@
     (:vertical 1)
     (:horizontal 2)))
 
-
-
 (def-c-type (x-arglist :in-foreign-space) 1 :unsigned-long)
 
 (defun get-values (widget &rest resources)
diff --git a/tk/widget.lisp b/tk/widget.lisp
index 8ace3d9c..af9eb3d4 100644
--- a/tk/widget.lisp
+++ b/tk/widget.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: widget.lisp,v 1.14 92/03/30 17:51:51 cer Exp Locker: cer $
+;; $fiHeader: widget.lisp,v 1.15 92/04/10 14:26:19 cer Exp Locker: cer $
 
 (in-package :tk)
 
@@ -46,8 +46,6 @@
 	    :display display
 	    args))))
 
-
-
 (defun create-widget (name widget-class parent &rest args)
   (apply #'create-widget-1 
 	 #'create_widget name widget-class parent 
@@ -69,40 +67,29 @@
 	     arglist
 	     (truncate (length arglist) 2))))
 
-
-
 (defun realize-widget (widget)
   (realize_widget widget))
 
-
-
 (defun manage-child (child)
   (manage_child child))
 
-
-
+(defun unmanage-child (child)
+  (unmanage_child child))
 
 (defun is-managed-p (widget)
     (not (zerop (xt_is_managed widget))))
 
-(defun unmanage-child (child)
-  (unmanage_child child))
-
 (defun manage-children (children)
   (manage_children (map '(simple-array (signed-byte 32))
 		     #'ff:foreign-pointer-address 
 		     children)
 		   (length children)))
-
-
+		     
 (defun destroy-widget (widget)
   (destroy_widget widget))
 
-
-
 (defun popup (shell)
-       (_popup shell
-	       0))
+       (_popup shell 0))
 
 (defun popdown (shell)
        (_popdown shell))
@@ -149,7 +136,7 @@
 
 (defmethod initialize-instance :after ((w xt-root-class) 
 				       &rest args 
-				       &key foreign-address
+				       &key foreign-address 
 				       parent display
 				       &allow-other-keys)
   (when (or display parent)
@@ -239,7 +226,6 @@
        (logtest r x11:cwheight)
        (logtest r x11:cwborderwidth)))))
 
-
 ;;--- Should call either XtResizeWidget or XtConfigureWidget
 
 (defun tk::configure-widget (widget &key x y width height 
diff --git a/tk/xlib.lisp b/tk/xlib.lisp
index 4fb3e593..d0a390a9 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.12 92/03/10 15:39:53 cer Exp $
+;; $fiHeader: xlib.lisp,v 1.13 92/03/30 17:51:52 cer Exp $
 
 (in-package :tk)
 
@@ -80,8 +80,8 @@
 
 (defmethod drawable-backing-store ((window window))
   (let ((attrs (x11:make-xwindowattributes)))
-    (x11:xgetwindowattributes (display-handle (object-display window))
-			      (object-handle window)
+    (x11:xgetwindowattributes (object-display window)
+			      window
 			      attrs)
     (not (zerop (x11:xwindowattributes-backing-store attrs)))))
 
@@ -118,7 +118,7 @@
   (let ((s (string-to-char* (make-string 1000))))
     (x11::xgeterrortext display-handle code s 1000)
     (char*-to-string s)))
-
+      
 (defun setup-error-handlers ()
   (x11:xseterrorhandler (register-function 'x-error-handler))
   (x11:xsetioerrorhandler (register-function 'x-io-error-handler)))
@@ -126,6 +126,7 @@
 (eval-when (load)
   (setup-error-handlers))
 
+
 (defmethod display-root-window (display)
   (intern-object-xid
    (x11:xdefaultrootwindow display)
@@ -148,8 +149,7 @@
 
 (defclass color (ff:foreign-pointer) ())
 
-(defmethod initialize-instance :after ((x color) &key foreign-address red green
-				       blue)
+(defmethod initialize-instance :after ((x color) &key foreign-address red green blue)
   (unless foreign-address
     (setq foreign-address (x11::make-xcolor))
     (setf (x11::xcolor-red foreign-address) red
@@ -164,7 +164,7 @@
    (let ((cm o))
      (format s "~D,~D,~D"
 	     (x11:xcolor-red cm)
-	     (x11:xcolor-green  cm)
+	     (x11:xcolor-green cm)
 	     (x11:xcolor-blue cm)))))
 
 (defun lookup-color (colormap color-name)
@@ -181,8 +181,7 @@
 	      (make-instance 'color :foreign-address closest)))))
 
 (defun allocate-color (colormap x)
-  (let ((y (x11::make-xcolor))
-	(x x))
+  (let ((y (x11::make-xcolor)))
     (setf (x11:xcolor-red y) (x11:xcolor-red x)
 	  (x11:xcolor-green y) (x11:xcolor-green x)
 	  (x11:xcolor-blue y) (x11:xcolor-blue x))
@@ -227,11 +226,11 @@
 	  (values
 	   t
 	   (intern-object-xid
-	    (aref root 0)
+	    (aref root 0) 
 	    'window
 	    :display display)
 	   (intern-object-xid
-	    (aref child 0)
+	    (aref child 0) 
 	    'window
 	    :display display)
 	   (aref root-x 0)
@@ -341,7 +340,7 @@
        (x11:xlookupstring
 	event
 	buffer
-	2 
+	2
 	keysym
 	0)
        (prog1
diff --git a/tk/xm-classes.lisp b/tk/xm-classes.lisp
index dc2b2725..74f6e479 100644
--- a/tk/xm-classes.lisp
+++ b/tk/xm-classes.lisp
@@ -20,15 +20,16 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-classes.lisp,v 1.2 92/02/24 13:03:56 cer Exp Locker: cer $
+;; $fiHeader: xm-classes.lisp,v 1.3 92/03/30 17:51:54 cer Exp $
 
-;;; This has to kept consistent with the Makefile
 
 (provide :climxm)
 (require :climg)
 
 (in-package :tk)
 
+;;; This has to kept consistent with the Makefile
+
 (defparameter *motif-classes* '("_applicationShellWidgetClass"
 				"_compositeWidgetClass"
 				"_constraintWidgetClass"
diff --git a/utils/clim-macros.lisp b/utils/clim-macros.lisp
index a5b5a422..b3fd61a0 100644
--- a/utils/clim-macros.lisp
+++ b/utils/clim-macros.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clim-macros.lisp,v 1.2 92/02/24 13:05:18 cer Exp $
+;; $fiHeader: clim-macros.lisp,v 1.3 92/03/04 16:20:03 cer Exp $
 
 (in-package :clim-utils)
 
@@ -93,9 +93,9 @@
     `(let ((,cx ,x)
 	   (,cy ,y))
        (unless (and ,cx ,cy)
-	 (multiple-value-setq (,cx ,cy) (stream-cursor-position* ,stream)))
+	 (multiple-value-setq (,cx ,cy) (stream-cursor-position ,stream)))
        (multiple-value-bind (,tx ,ty)
-	   (transform-point* (medium-transformation ,stream) 0 0)
+	   (transform-position (medium-transformation ,stream) 0 0)
 	 (with-drawing-options
 	     (,stream :transformation (make-translation-transformation
 					(- ,cx ,tx) (- ,cy ,ty)))
@@ -110,9 +110,9 @@
     `(let ((,cx ,x)
 	   (,cy ,y))
        (unless (and ,cx ,cy)
-	 (multiple-value-setq (,cx ,cy) (stream-cursor-position* ,stream)))
+	 (multiple-value-setq (,cx ,cy) (stream-cursor-position ,stream)))
        (multiple-value-bind (,tx ,ty)
-	   (transform-point* (medium-transformation ,stream) 0 0)
+	   (transform-position (medium-transformation ,stream) 0 0)
 	 (with-drawing-options
 	     ;; Don't flip the stream over if we already have
 	     (,stream :transformation (if (silica:medium-+Y-upward-p ,stream)
diff --git a/utils/clos.lisp b/utils/clos.lisp
index 86636e2d..efc8389e 100644
--- a/utils/clos.lisp
+++ b/utils/clos.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clos.lisp,v 1.3 92/02/24 13:05:23 cer Exp $
+;; $fiHeader: clos.lisp,v 1.4 92/03/04 16:20:08 cer Exp $
 
 ;;;
 ;;; Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved. 
@@ -253,7 +253,7 @@
 		 `(funcall #',',setf-function-name ,@store-temps ,@temps)
 		 `(,',accessor-name ,@temps))))))
 
-;; For example, (DEFGENERIC* (SETF POSITION*) (X Y OBJECT))
+;; For example, (DEFGENERIC* (SETF CURSOR-POSITION) (X Y CURSOR))
 (defmacro defgeneric* (function-spec lambda-list &body options)
   (assert (and (listp function-spec)
 	       (eq (first function-spec) 'setf)
@@ -268,8 +268,8 @@
        ,(expand-defsetf-for-defmethod* accessor-name accessor-arg
 				       lambda-list setf-function-name))))
 
-;; For example, (DEFMETHOD* (SETF POSITION*) (NX NY (OBJECT T)) ...)
-;; Then (SETF (POSITION* object) (VALUES nx ny))
+;; For example, (DEFMETHOD* (SETF CURSOR-POSITION) (NX NY (CURSOR T)) ...)
+;; Then (SETF (CURSOR-POSITION cursor) (VALUES nx ny))
 (defmacro defmethod* (name &body quals-lambda-list-and-body)
   (declare (arglist name [qualifiers]* lambda-list &body body))
   #+Genera (declare (zwei:indentation . zwei:indent-for-clos-defmethod))
diff --git a/utils/coral-char-bits.lisp b/utils/coral-char-bits.lisp
index 5ae97352..513c7cf7 100644
--- a/utils/coral-char-bits.lisp
+++ b/utils/coral-char-bits.lisp
@@ -1,7 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-
-;; $fiHeader: coral-char-bits.lisp,v 1.3 92/02/24 13:05:27 cer Exp $
+;; $fiHeader: coral-char-bits.lisp,v 1.4 92/03/10 10:11:48 cer Exp $
 
 (in-package :clim-utils)
 
@@ -11,14 +10,14 @@
 ;; there ain't no such thing in ANSI CL.  Here in Coral, at least, we
 ;; can temporarily kludge around it.
 (defun %set-char-bits (ch b)
-  (declare (fixnum ch)) ; a lie
-  (let ((mask (ash b (- 8 3)))) ; fixnums are "shifted left" three bits
-    (declare (fixnum mask))
-    ; I'm so ashamed
+  (declare (type fixnum ch))			;a lie
+  (let ((mask (ash b (- 8 3))))		;fixnums are "shifted left" three bits
+    (declare (type fixnum mask))
+    ;; I'm so ashamed
     (logior ch mask)))
 
 (defun char-bits (ch)
-  (declare (fixnum ch))
+  (declare (type fixnum ch))
   ;; Extremely gross
   (ccl::lsh (logand ch (ash #x0000FF00 -3)) -5))
 
@@ -26,7 +25,7 @@
 (declaim (inline char=))
 
 (defun char= (ch1 ch2)
-  (declare (fixnum ch1 ch2))
+  (declare (type fixnum ch1 ch2))
   ;; Really gross!
   (ccl::require-type ch1 'character)
   (ccl::require-type ch2 'character)
diff --git a/utils/defun-utilities.lisp b/utils/defun-utilities.lisp
index f723717e..c6d84505 100644
--- a/utils/defun-utilities.lisp
+++ b/utils/defun-utilities.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;;; $fiHeader: defun-utilities.lisp,v 1.5 92/02/24 13:05:30 cer Exp $
+;;; $fiHeader: defun-utilities.lisp,v 1.6 92/03/04 16:20:13 cer Exp $
 
 (in-package :clim-utils)
 
@@ -51,4 +51,45 @@
 		     (return-from process-declarations)))))))
     (values documentation `((declare ,@declarations)) body)))
 
+
+;;; DEFINE-GROUP: defines a "group" of definitions which are related
+;;; somehow.  In Genera, this causes the function-parents to be set
+;;; correctly, for example, and also if you attempt to abort out of the
+;;; middle you get told that something might be left inconsistent.
+#+Genera 
+(defmacro define-group (name type &body body)
+  `(sys:multiple-definition ,name ,type ,@body))
+
+#+(and Allegro (version>= 4 1))
+(defmacro define-group (name type &body body)
+  `(progn
+     (excl::record-source-file ',name :type ',type)
+     ,@body))
+
+#-(or Genera (and Allegro (version>= 4 1)))
+(defmacro define-group (name type &body body)
+  (declare (ignore name type))
+  `(progn ,@body))
+
+(defmacro with-warnings-for-definition (name type &body body)
+  #+Genera `(let ((compiler:default-warning-function ,name)
+		  (compiler:default-warning-definition-type ',type))
+	      ,@body)
+  #-Genera `(let () ,@body))
+
+(defmacro defun-inline (name lambda-list &body body)
+  `(define-group ,name defun-inline
+     (eval-when (compile load eval) (proclaim '(inline ,name)))
+     (defun ,name ,lambda-list
+       ,@body)))
+
+#+Genera
+(progn
+  (setf (get 'defun-inline 'zwei:definition-function-spec-parser)
+	(zl:::scl:function (:property zl:::scl:defun zwei:definition-function-spec-parser)))
+  (setf (get 'defun-inline 'zwei:definition-function-spec-type) 'zl:::scl:defun)
+  (setf (get 'defun-inline 'gprint::formatter) 
+	(zl:::scl:function (:property zl:::scl:defun gprint::formatter)))
+  (push 'defun-inline zwei:*irrelevant-functions*)
+  (push 'defun-inline zwei:*irrelevant-defining-forms*))
 
diff --git a/utils/extended-regions.lisp b/utils/extended-regions.lisp
index a3930749..d516b710 100644
--- a/utils/extended-regions.lisp
+++ b/utils/extended-regions.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: extended-regions.lisp $
+;; $fiHeader: extended-regions.lisp,v 1.1 92/02/24 13:13:38 cer Exp $
 
 (in-package :clim-utils)
 
@@ -78,7 +78,7 @@
 ;; By using perpendicular-distance from line instead of slope and intercept
 ;; we don't have to worry about divide by zero in slope and we're also more
 ;; robust against roundoff error.
-(defmethod region-contains-point*-p ((line standard-line) x y)
+(defmethod region-contains-position-p ((line standard-line) x y)
   (with-slots (start-x start-y end-x end-y) line
     (let ((x1 start-x) (y1 start-y) (x2 end-x) (y2 end-y))
       (when (or (<= x1 x x2)
@@ -89,8 +89,8 @@
 
 (defmethod region-contains-region-p ((line1 standard-line) (line2 standard-line))
   (with-slots (start-x start-y end-x end-y) line2
-    (and (region-contains-point*-p line1 start-x start-y)
-	 (region-contains-point*-p line1 end-x end-y))))
+    (and (region-contains-position-p line1 start-x start-y)
+	 (region-contains-position-p line1 end-x end-y))))
 
 (defmethod region-intersects-region-p ((line1 standard-line) (line2 standard-line))
   (with-slots ((sx1 start-x) (sy1 start-y) (ex1 end-x) (ey1 end-y)) line1
@@ -114,9 +114,9 @@
 (defmethod transform-region (transformation (line standard-line))
   (with-slots (start-x start-y end-x end-y) line
     (multiple-value-bind (sx sy)
-	(transform-point* transformation start-x start-y)
+	(transform-position transformation start-x start-y)
       (multiple-value-bind (ex ey)
-	  (transform-point* transformation end-x end-y)
+	  (transform-position transformation end-x end-y)
 	(make-line* sx sy ex ey)))))
 
 (defmethod bounding-rectangle* ((line standard-line))
@@ -162,11 +162,11 @@
 	  (when (polyline-closed polygon)
 	    (funcall function x y x1 y1)))
 	(multiple-value-bind (x1 y1)
-	    (point-position* (aref points 0))
+	    (point-position (aref points 0))
 	  (let ((x x1) (y y1))
 	    (dotimes (i (1- (length points)))
 	      (multiple-value-bind (nx ny)
-		  (point-position* (aref points (1+ i)))
+		  (point-position (aref points (1+ i)))
 		(funcall function x y nx ny)
 		(psetf x nx y ny)))
 	    (when (polyline-closed polygon)
@@ -202,7 +202,7 @@
   (let ((coords nil))
     (flet ((transform-coord (x y)
 	     (multiple-value-bind (nx ny)
-		 (transform-point* transformation x y)
+		 (transform-position transformation x y)
 	       (push ny coords)
 	       (push nx coords))))
       (declare (dynamic-extent #'transform-coord))
@@ -228,7 +228,7 @@
   (let ((coords nil))
     (flet ((transform-coord (x y)
 	     (multiple-value-bind (nx ny)
-		 (transform-point* transformation x y)
+		 (transform-position transformation x y)
 	       (push ny coords)
 	       (push nx coords))))
       (declare (dynamic-extent #'transform-coord))
@@ -303,7 +303,7 @@
   (with-slots (center-x center-y radius-1-dx radius-1-dy radius-2-dx radius-2-dy
 	       start-angle end-angle) ellipse
     (multiple-value-bind (cx cy)
-	(transform-point* transformation center-x center-y)
+	(transform-position transformation center-x center-y)
       (multiple-value-bind (r1-dx r1-dy)
 	  (transform-distance transformation radius-1-dx radius-1-dy)
 	(multiple-value-bind (r2-dx r2-dy)
@@ -359,7 +359,7 @@
   (with-slots (center-x center-y radius-1-dx radius-1-dy radius-2-dx radius-2-dy
 	       start-angle end-angle) ellipse
     (multiple-value-bind (cx cy)
-	(transform-point* transformation center-x center-y)
+	(transform-position transformation center-x center-y)
       (multiple-value-bind (r1-dx r1-dy)
 	  (transform-distance transformation radius-1-dx radius-1-dy)
 	(multiple-value-bind (r2-dx r2-dy)
diff --git a/utils/lisp-utilities.lisp b/utils/lisp-utilities.lisp
index 881037c3..0a6d0abc 100644
--- a/utils/lisp-utilities.lisp
+++ b/utils/lisp-utilities.lisp
@@ -1,6 +1,6 @@
  ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: lisp-utilities.lisp,v 1.6 92/03/10 10:11:52 cer Exp $
+;; $fiHeader: lisp-utilities.lisp,v 1.7 92/03/30 17:52:12 cer Exp $
 
 (in-package :clim-utils)
 
@@ -28,7 +28,22 @@
   ;;--- Turn this into 'SINGLE-FLOAT after debugging the type declarations
   #+Silica 't)
 
-;;--- Should this use FLOOR, CEILING, or ROUND?
+;; Convert a number of arbitrary type into a COORDINATE
+(defmacro coordinate (x &optional (round-direction 'round))
+  #+Silica (declare (ignore round-direction))
+  #-Silica (ecase round-direction
+	     (round
+	       `(the fixnum (values (floor (+ ,x .5f0)))))
+	     (floor
+	       `(the fixnum (values (floor ,x))))
+	     (ceiling
+	       `(the fixnum (values (ceiling ,x)))))
+  #+Silica `(the coordinate (float ,x 0f0)))
+
+(defconstant +largest-coordinate+
+	     #-Silica most-positive-fixnum
+	     #+Silica (float (expt 10 (floor (log most-positive-fixnum 10))) 0f0))
+
 (defmacro integerize-single-float-coordinate (coord)
   `(the fixnum (values (floor (+ (the single-float ,coord) .5f0)))))
 
@@ -38,10 +53,19 @@
 (defmacro integerize-float-coordinate (coord)
   `(the fixnum (values (floor (+ (the float ,coord) .5)))))
 
-#-allegro
-(defun integerize-coordinate (coord)
-  (declare (optimize (speed 3) (safety 0))
-	   (:explain :calls :types))
+#+(or Genera Minima)
+(defun-inline fix-coordinate (coord)
+  (if (typep coord 'fixnum)
+      coord
+      (the fixnum (values (floor (+ coord .5f0))))))
+
+#+Allegro
+(defmacro fix-coordinate (coord)
+  ;; ROUND is good enough in Allegro for 90% of the speed, and it's less filling.
+  `(the fixnum (round ,coord)))
+
+#-(or Genera Minima Allegro)
+(defun fix-coordinate (coord)
   (etypecase coord
     (fixnum coord)
     (single-float
@@ -55,19 +79,58 @@
     ;; disallow bignums and other types of numbers
     ))
 
-#+allegro
-(defmacro integerize-coordinate (coord)
-  ;; Round is good enough in Allegro for 90% of the speed, and it's less
-  ;; filling.
-  `(the fixnum (round ,coord)))
-
-
-(defmacro integerize-coordinates (&body coords)
+(defmacro fix-coordinates (&body coords)
   `(progn
-     ,@(mapcar #'(lambda (x)
-		   `(setq ,x (integerize-coordinate ,x)))
+     ,@(mapcar #'(lambda (x) `(setq ,x (fix-coordinate ,x)))
 	       coords)))
 
+;;; ONCE-ONLY does the same thing as it does in zetalisp.  I should have just
+;;; lifted it from there but I am honest.  Not only that but this one is
+;;; written in Common Lisp.  I feel a lot like bootstrapping, or maybe more
+;;; like rebuilding Rome.
+(defmacro once-only (vars &body body)
+  (let ((gensym-var (gensym))
+        (run-time-vars (gensym))
+        (run-time-vals (gensym))
+        (expand-time-val-forms ()))
+    (dolist (var vars)
+      (push `(if (or (symbolp ,var)
+                     (numberp ,var)
+                     (and (listp ,var)
+			  (member (car ,var) '(quote function))))
+                 ,var
+                 (let ((,gensym-var (gensym)))
+                   (push ,gensym-var ,run-time-vars)
+                   (push ,var ,run-time-vals)
+                   ,gensym-var))
+            expand-time-val-forms))    
+    `(let* (,run-time-vars
+            ,run-time-vals
+            (wrapped-body
+	      (let ,(mapcar #'list vars (reverse expand-time-val-forms))
+		,@body)))
+       `(let ,(mapcar #'list (reverse ,run-time-vars)
+			     (reverse ,run-time-vals))
+	  ,wrapped-body))))
+
+(defmacro dorest ((var list &optional (by 'cdr)) &body body)
+  `(do ((,var ,list (,by ,var)))
+       ((null ,var) nil)
+     ,@body))
+
+;; COORDINATE-PAIRS is a list of pairs of coordinates.
+;; The coordinates must be of type COORDINATE
+(defmacro translate-coordinates (x-delta y-delta &body coordinate-pairs)
+  (once-only (x-delta y-delta)
+    `(progn
+       ,@(let ((forms nil))
+	   (dorest (pts coordinate-pairs cddr)
+	     (push `(setf ,(first pts)  
+			  (the coordinate (+ ,(first pts)  ,x-delta))) forms)
+	     (push `(setf ,(second pts)
+			  (the coordinate (+ ,(second pts) ,y-delta))) forms))
+	   (nreverse forms)))))
+
 (defmacro convert-to-device-coordinates (transform &body positions)
   (assert (evenp (length positions)) (positions)
 	  "There must be an even number of elements in ~S" positions)
@@ -79,8 +142,8 @@
 	     (y (pop positions)))
 	(push `(multiple-value-setq (,x ,y)
 		 (multiple-value-bind (nx ny) 
-		     (transform-point* ,transform ,x ,y)
-		   (values (integerize-coordinate nx) (integerize-coordinate ny))))
+		     (transform-position ,transform ,x ,y)
+		   (values (fix-coordinate nx) (fix-coordinate ny))))
 	      forms)))))
 
 (defmacro convert-to-device-distances (transform &body positions)
@@ -95,7 +158,7 @@
 	(push `(multiple-value-setq (,x ,y)
 		 (multiple-value-bind (nx ny) 
 		     (transform-distance ,transform ,x ,y)
-		   (values (integerize-coordinate nx) (integerize-coordinate ny))))
+		   (values (fix-coordinate nx) (fix-coordinate ny))))
 	      forms)))))
 
 
@@ -375,48 +438,6 @@
                        (t nil))))
          ,@body))))
 
-
-;;; DEFINE-GROUP: defines a "group" of definitions which are related
-;;; somehow.  In Genera, this causes the function-parents to be set
-;;; correctly, for example, and also if you attempt to abort out of the
-;;; middle you get told that something might be left inconsistent.
-#+Genera 
-(defmacro define-group (name type &body body)
-  `(sys:multiple-definition ,name ,type ,@body))
-
-#+(and Allegro (version>= 4 1))
-(defmacro define-group (name type &body body)
-  `(progn
-     (excl::record-source-file ',name :type ',type)
-     ,@body))
-
-#-(or Genera (and Allegro (version>= 4 1)))
-(defmacro define-group (name type &body body)
-  (declare (ignore name type))
-  `(progn ,@body))
-
-(defmacro with-warnings-for-definition (name type &body body)
-  #+Genera `(let ((compiler:default-warning-function ,name)
-		  (compiler:default-warning-definition-type ',type))
-	      ,@body)
-  #-Genera `(let () ,@body))
-
-(defmacro defun-inline (name lambda-list &body body)
-  `(define-group ,name defun-inline
-     (eval-when (compile load eval) (proclaim '(inline ,name)))
-     (defun ,name ,lambda-list
-       ,@body)))
-
-#+Genera
-(progn
-  (setf (get 'defun-inline 'zwei:definition-function-spec-parser)
-	(zl:::scl:function (:property zl:::scl:defun zwei:definition-function-spec-parser)))
-  (setf (get 'defun-inline 'zwei:definition-function-spec-type) 'zl:::scl:defun)
-  (setf (get 'defun-inline 'gprint::formatter) 
-	(zl:::scl:function (:property zl:::scl:defun gprint::formatter)))
-  (push 'defun-inline zwei:*irrelevant-functions*)
-  (push 'defun-inline zwei:*irrelevant-defining-forms*))
-
 
 ;;; Bindings on the stack.  A work in progress.
 ;;; Which Lisps support this?
@@ -630,7 +651,7 @@
 	      (,endd ,(if simple-p `,end `(or ,end (length ,fvector))))
 	      (,index (if ,from-end (1- ,endd) ,startd))
 	      (,limit (if ,from-end (1- ,startd) ,endd)))
-	 (declare (fixnum ,endd ,index ,limit)
+	 (declare (type fixnum ,endd ,index ,limit)
 		  ;; Turn on the afterburners...
 		  (optimize (speed 3) (safety 0))
 		  ,@(and simple-p `((type simple-vector ,fvector)))
@@ -650,11 +671,6 @@
 	 (list (dolist (thing ,sequence) (,fcn thing)))
 	 (vector (dovector (thing ,sequence) (,fcn thing)))))))
 
-(defmacro dorest ((var list &optional (by 'cdr)) &body body)
-  `(do ((,var ,list (,by ,var)))
-       ((null ,var) nil)
-     ,@body))
-
 (defmacro writing-clauses (&body body)
   (let ((clauses-var (gensymbol 'clauses)))
     `(let ((,clauses-var nil))
@@ -994,7 +1010,7 @@
 	   (,next-var nil)
 	   ,@(when (cdr special-characters)
 	       `((,char-var ,(car special-characters)))))
-       (declare (fixnum ,start-index-var ,end-var ,end-index-var)
+       (declare (type fixnum ,start-index-var ,end-var ,end-index-var)
 		(type (or fixnum null) ,next-var)
 		(character ,char-var))
        (loop
@@ -1153,34 +1169,6 @@
     `(or (float ,(convert min t) ,(convert max t))
 	 (rational ,(convert min nil) ,(convert max nil)))))
 
-;;; ONCE-ONLY does the same thing as it does in zetalisp.  I should have just
-;;; lifted it from there but I am honest.  Not only that but this one is
-;;; written in Common Lisp.  I feel a lot like bootstrapping, or maybe more
-;;; like rebuilding Rome.
-(defmacro once-only (vars &body body)
-  (let ((gensym-var (gensym))
-        (run-time-vars (gensym))
-        (run-time-vals (gensym))
-        (expand-time-val-forms ()))
-    (dolist (var vars)
-      (push `(if (or (symbolp ,var)
-                     (numberp ,var)
-                     (and (listp ,var)
-			  (member (car ,var) '(quote function))))
-                 ,var
-                 (let ((,gensym-var (gensym)))
-                   (push ,gensym-var ,run-time-vars)
-                   (push ,var ,run-time-vals)
-                   ,gensym-var))
-            expand-time-val-forms))    
-    `(let* (,run-time-vars
-            ,run-time-vals
-            (wrapped-body
-	      (let ,(mapcar #'list vars (reverse expand-time-val-forms))
-		,@body)))
-       `(let ,(mapcar #'list (reverse ,run-time-vars)
-			     (reverse ,run-time-vals))
-	  ,wrapped-body))))
 
 ;;; Use a lambda-list to extract arguments from a list and bind variables.
 ;;; This "should" signal an error if the list doesn't match the lambda-list.
@@ -1359,7 +1347,7 @@
 ;;; Simple vector support
 
 (defun-inline copy-vector-portion (from-vector from-start to-vector to-start length)
-  (declare (fixnum from-start to-start length)
+  (declare (type fixnum from-start to-start length)
 	   (type simple-vector from-vector to-vector))
   (declare (optimize (speed 3) (safety 0)))
   (cond (#+Genera (< length 8) #-Genera t
@@ -1382,9 +1370,10 @@
 ;; (MULTIPLE-VALUE-SETQ (VECTOR FP) (SIMPLE-VECTOR-PUSH-EXTEND ELEMENT VECTOR FP)).
 (defun simple-vector-push-extend (element vector fill-pointer &optional extension)
   (declare (values vector fill-pointer))
-  (declare (fixnum fill-pointer) (type simple-vector vector))
+  (declare (type fixnum fill-pointer)
+	   (type simple-vector vector))
   (let ((length (array-dimension vector 0)))
-    (declare (fixnum length))
+    (declare (type fixnum length))
     (when (= fill-pointer length)
       ;; Grow the vector
       (let ((new-vector (make-array (+ length (max (ash length -1) (or extension 20)))
@@ -1398,9 +1387,10 @@
 
 (defun simple-vector-insert-element (element index vector fill-pointer &optional extension)
   (declare (values vector fill-pointer))
-  (declare (fixnum index fill-pointer) (type simple-vector vector))
+  (declare (type fixnum index fill-pointer)
+	   (type simple-vector vector))
   (let ((length (array-dimension vector 0)))
-    (declare (fixnum length))
+    (declare (type fixnum length))
     (cond ((= fill-pointer length)
 	   ;; Grow the vector, leaving a hole for the new element
 	   (let ((new-vector (make-array (+ length (max (ash length -1) (or extension 20)))
@@ -1415,7 +1405,7 @@
 	     #+Minima (declare (type vector vector))
 	     (do ((i fill-pointer (1- i)))
 		 ((= i index))
-	       (declare (fixnum i)
+	       (declare (type fixnum i)
 			(optimize (speed 3) (safety 0)))
 	       (setf (svref vector i) (svref vector (1- i)))))))
     ;; Plug in the new element and return the right values
diff --git a/utils/packages.lisp b/utils/packages.lisp
index 21429daf..28da544a 100644
--- a/utils/packages.lisp
+++ b/utils/packages.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: packages.lisp,v 1.9 92/04/03 12:04:20 cer Exp Locker: cer $
+;; $fiHeader: packages.lisp,v 1.10 92/04/10 14:26:42 cer Exp Locker: cer $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user)
 
@@ -1472,11 +1472,12 @@
     with-open-stream)
 
   (:export
-    ;; Geometry
+    ;; Regions
     +everywhere+
     +nowhere+
     area
     areap
+    coordinate
     ellipse
     ellipse-center-point
     ellipse-center-point*
@@ -1511,7 +1512,7 @@
     path
     pathp
     point
-    point-position*
+    point-position
     point-x
     point-y
     pointp
@@ -1534,7 +1535,7 @@
     rectangle-width
     rectanglep
     region
-    region-contains-point*-p
+    region-contains-position-p
     region-contains-region-p
     region-difference
     region-equal
@@ -1565,7 +1566,7 @@
     bounding-rectangle-min-x
     bounding-rectangle-min-y
     bounding-rectangle-p
-    bounding-rectangle-position*
+    bounding-rectangle-position
     bounding-rectangle-size
     bounding-rectangle-width
     bounding-rectangle-left
@@ -1606,7 +1607,7 @@
     scaling-transformation-p
     singular-transformation
     transform-distance
-    transform-point*
+    transform-position
     transform-rectangle*
     transform-region
     transformation
@@ -1616,7 +1617,7 @@
     transformationp
     translation-transformation-p
     untransform-distance
-    untransform-point*
+    untransform-position
     untransform-rectangle*
     untransform-region
     
@@ -1631,14 +1632,16 @@
     +shift-key+
     +super-key+
     add-watcher
+    allocate-medium
     bursting-input-queuer
     bury-sheet
-    child-containing-point
-    child-containing-point*
+    child-containing-position
     children-overlapping-rectangle*
     children-overlapping-region
     copy-event
+    deallocate-medium
     define-sheet-class
+    degraft-medium
     delegate-sheet-delegate
     delegate-sheet-input-mixin
     delete-watcher
@@ -1656,6 +1659,7 @@
     distribute-device-event
     distribute-event
     enable-mirror
+    engraft-medium
     enter-region
     event
     event-listen
@@ -1699,10 +1703,10 @@
     map-over-grafts
     map-over-ports
     map-over-sheets
-    map-sheet-bounding-rectangle*-to-child
-    map-sheet-bounding-rectangle*-to-parent
-    map-sheet-point*-to-child
-    map-sheet-point*-to-parent
+    map-sheet-position-to-child
+    map-sheet-position-to-parent
+    map-sheet-rectangle*-to-child
+    map-sheet-rectangle*-to-parent
     medium
     medium-background
     medium-clipping-region
@@ -1745,12 +1749,13 @@
     pointer-event-y
     pointer-exit-event
     pointer-motion-event
-    port-notify-user
     poll-pointer
     port
     port-keyboard-input-focus
+    port-notify-user
     port-properties
     port-server-path
+    port-type
     portp
     primitive-sheet-output-mixin
     process-next-event
@@ -1847,6 +1852,7 @@
     
     ;; Text styles
     *default-text-style*
+    *undefined-text-style*
     invoke-with-text-style
     make-device-font-text-style
     make-text-style
@@ -1922,7 +1928,7 @@
     port-draw-text*
     with-output-to-pixmap
     
-    ;; Color
+    ;; Colors
     +background-ink+
     +flipping-ink+
     +foreground-ink+
@@ -1943,7 +1949,7 @@
     opacity-value
     opacityp
     
-    ;; Patterns
+    ;; Designs
     compose-in
     compose-out
     compose-over
@@ -1958,7 +1964,7 @@
     cursor
     cursor-active
     cursor-focus
-    cursor-position*
+    cursor-position
     cursor-sheet
     cursor-state
     cursor-visibility
@@ -1975,13 +1981,13 @@
     stream-baseline
     stream-character-width
     stream-clear-output
-    stream-cursor-position*
+    stream-cursor-position
     stream-end-of-line-action
     stream-end-of-page-action
     stream-finish-output
     stream-force-output
     stream-fresh-line
-    stream-increment-cursor-position*
+    stream-increment-cursor-position
     stream-line-column
     stream-line-height
     stream-start-line-p
@@ -2015,18 +2021,18 @@
     invoke-with-output-recording-options
     invoke-with-output-to-output-record
     make-design-from-output-record
-    map-over-output-records-containing-point*
+    map-over-output-records-containing-position
     map-over-output-records-overlapping-region
     output-record
     output-record-children
     output-record-count
-    output-record-end-cursor-position*
-    output-record-hit-detection-rectangle*
+    output-record-end-cursor-position
+    output-record-hit-detection-rectangle
     output-record-p
     output-record-parent
-    output-record-position*
+    output-record-position
     output-record-refined-sensitivity-test
-    output-record-start-cursor-position*
+    output-record-start-cursor-position
     output-recording-stream
     output-recording-stream-p
     recompute-extent-for-changed-child
@@ -2146,9 +2152,16 @@
     updating-output-record-p
     
     ;; Extended input
+    *abort-gestures*
+    *accelerator-gestures*
     *input-wait-handler*
     *input-wait-test*
     *pointer-button-press-handler*
+    abort-gesture
+    abort-gesture-event
+    accelerator-gesture
+    accelerator-gesture-event
+    accelerator-gesture-numeric-argument
     add-gesture-name
     define-gesture-name
     delete-gesture-name
@@ -2164,7 +2177,7 @@
     pointer-buttons
     pointer-cursor
     pointer-port
-    pointer-position*
+    pointer-position
     pointer-sheet
     pointerp
     read-gesture
@@ -2176,7 +2189,7 @@
     stream-input-wait
     stream-listen
     stream-peek-char
-    stream-pointer-position*
+    stream-pointer-position
     stream-pointers
     stream-primary-pointer
     stream-read-char
@@ -2207,10 +2220,10 @@
     accept-method
     accept-present-default
     accept-present-default-method
+    apply-presentation-generic-function
     and
     blank-area
     boolean
-    call-presentation-generic-function
     call-presentation-menu
     call-presentation-translator
     character
@@ -2240,6 +2253,7 @@
     float
     form
     frame-document-highlighted-presentation
+    funcall-presentation-generic-function
     gadget-dialog-view
     gadget-menu-view
     gadget-view
@@ -2324,14 +2338,12 @@
     with-presentation-type-parameters
     
     ;; Input editing and completion
-    *abort-gestures*
     *activation-gestures*
     *completion-gestures*
     *delimiter-gestures*
     *help-gestures*
     *possibilities-gestures*
     *standard-activation-gestures*
-    abort-gesture
     activation-gesture-p
     complete-from-generator
     complete-from-possibilities
@@ -2369,6 +2381,7 @@
     write-token
     
     ;; Menus
+    draw-standard-menu
     menu-choose
     menu-choose-from-drawer
     menu-item
@@ -2385,6 +2398,7 @@
     accept-values-resynchronize
     accepting-values
     display-exit-boxes
+    invoke-accept-values-command-button
     
     ;; Command processor
     *command-argument-delimiters*
@@ -2465,6 +2479,7 @@
     application-pane
     client-setting
     command-enabled
+    command-menu-pane
     default-frame-top-level
     define-application-frame
     disable-frame
@@ -2487,6 +2502,7 @@
     frame-input-context-button-press-handler
     frame-maintain-presentation-histories
     frame-manager
+    frame-manager-frames
     frame-name
     frame-named-panes
     frame-pane
@@ -2516,8 +2532,6 @@
     pane-name
     pane-needs-redisplay
     panes-need-redisplay
-    pane-viewport
-    pane-viewport-region
     read-frame-command
     reconfigure-frame
     redisplay-frame-command-menu
@@ -2532,102 +2546,134 @@
     window-erase-viewport
     window-refresh
     window-viewport
-    window-viewport-position*
+    window-viewport-position
     with-application-frame
     with-frame-manager
     
     ;; Panes
     +fill+
+    allocate-space
+    bboard-pane
+    border-pane
     bordering
     change-space-requirement
     changing-space-requirements
     clim-stream-pane
     clim-stream-sheet
+    compose-space
+    hbox-pane
     horizontal-divider
     horizontally
+    hrack-pane
+    label-pane
     labelled
     lowering
     make-clim-pane
+    make-pane
+    make-pane-1
+    make-space-requirement
+    note-space-requirement-changed
+    outlined-pane
     outlining
     pane
     pane-background
     pane-foreground
+    pane-scroller
     pane-text-style
+    pane-viewport
+    pane-viewport-region
     raising
     make-pane
     make-pane-1
     restraining
+    restraining-pane
+    scroller-pane
     scrolling
+    space-requirement
+    space-requirement-height
+    space-requirement-max-height
+    space-requirement-max-width
+    space-requirement-min-height
+    space-requirement-min-width
+    space-requirement-width
     spacing
+    spacing-pane
+    table-pane
     tabling
-    text-editor
-    text-field
     text-stream-pane
     top-level-sheet
+    vbox-pane
     vertical-divider
     vertically
     viewport
+    viewport-viewport-region
+    vrack-pane
     with-look-and-feel-realization
     
-    ;; Adaptive toolkit
+    ;; Gadgets
+    action-gadget
     activate-callback
+    activate-gadget
     armed-callback
-    cascade-button-menu-group
     deactivate-gadget
     disarmed-callback
     drag-callback
     gadget
-    gadget-alignment
+    gadget-activate-callback
+    gadget-armed-callback
     gadget-client
+    gadget-disarmed-callback
     gadget-id
     gadget-indicator-type
     gadget-label
+    gadget-label-align-x
+    gadget-label-align-y
+    gadget-label-text-style
+    gadget-min-value
+    gadget-max-value
+    gadget-orientation
+    gadget-output-record
     gadget-orientation
     gadget-min-value
     gadget-max-value
     gadget-range
     gadget-range*
     gadget-value
+    gadget-value-changed-callback
     gadget-show-value-p
     label-pane
+    labelled-gadget
     menu-bar
+    menu-button
+    menu-button-pane
     note-gadget-activated
     note-gadget-deactivated
+    oriented-gadget
     push-button
-    push-button-show-as-default
+    push-button-pane
+    push-button-show-as-default-p
     radio-box
     radio-box-current-selection
+    radio-box-pane
     radio-box-selections
-    scrollbar
     scroll-bar
-    scroll-bar-max-value
-    scroll-bar-min-value
-    scroll-bar-orientation
-    scroll-bar-page-increment
-    scroll-bar-unit-increment
+    scroll-bar-drag-callback
+    scroll-bar-pane
     slider
-    slider-max-value
-    slider-min-value
-    slider-orientation
-    slider-show-value
+    slider-pane
+    slider-show-value-p
+    text-editor
+    text-editor-pane
     text-field
+    text-field-pane
     toggle-button
+    toggle-button-indicator-type
+    toggle-button-pane
     value-changed-callback
+    value-gadget
+    with-output-as-gadget
     with-radio-box
-    
-    ;; Pane layout
-    allocate-space
-    compose-space
-    make-space-requirement
-    note-space-requirement-changed
-    space-requirement
-    space-requirement-height
-    space-requirement-max-height
-    space-requirement-max-width
-    space-requirement-min-height
-    space-requirement-min-width
-    space-requirement-width
-    
+
     ;; Encapsulating streams
     *original-stream*
     encapsulating-stream
@@ -2774,19 +2820,16 @@
 
   ;; Need to export these since we don't hack SETF* yet
   (:export
-    output-record-set-position*
-    cursor-set-position*
-    stream-set-cursor-position*
-    stream-set-pointer-position*
-    window-set-viewport-position*)
+    cursor-set-position
+    output-record-set-position
+    pointer-set-position
+    stream-set-cursor-position
+    stream-set-pointer-position
+    window-set-viewport-position)
 
   ;; Some extensions until we decide what to do...
   (:export
-    *accelerator-gestures*
     +iconic-view+
-    accelerator-gesture
-    accelerator-gesture-event
-    accelerator-gesture-numeric-argument
     accept-values-command-parser
     catch-abort-gestures
     convert-from-absolute-to-relative-coordinates
@@ -2796,15 +2839,17 @@
     convert-to-stream-coordinates
     copy-textual-output-history
     #+Genera define-genera-application
-    draw-standard-menu
     draw-triangle
     draw-triangle*
     drawing-surface-to-viewport-coordinates
+    fix-coordinate
+    fix-coordinates
     iconic-view
     open-root-window
     open-window-stream
     position-window-near-carefully
     stream-pointer-position-in-window-coordinates
+    translate-coordinates
     translate-positions
     viewport-to-drawing-surface-coordinates
     window-children
@@ -2846,10 +2891,14 @@
     add-output-record-element
     add-text-style-mapping
     blip-character-p
+    bounding-rectangle-position*
+    call-presentation-generic-function
     command-enabled-p
     compose-rotation-transformation
     compose-scaling-tansformation
     compose-translation-transformation
+    cursor-position*
+    cursor-set-position*
     delete-output-record-element
     dialog-view
     disable-command
@@ -2867,6 +2916,8 @@
     map-over-output-record-elements-overlapping-region
     menu-view
     output-record-end-position*
+    output-record-position*
+    output-record-set-position*
     output-record-set-end-position*
     output-record-set-start-position*
     output-record-start-position
@@ -2874,11 +2925,21 @@
     output-recording-stream-current-output-record-stack
     output-recording-stream-output-history
     output-recording-stream-replay
+    point-position*
+    pointer-set-position*
     pointer-event-shift-mask
+    pointer-position*
     set-frame-layout
+    stream-cursor-position*
+    stream-set-cursor-position*
     stream-draw-p
+    stream-increment-cursor-position*
+    stream-pointer-position*
+    stream-set-pointer-position*
     stream-record-p
     stream-vsp
+    window-viewport-position*
+    window-set-viewport-position*
     with-activation-characters
     with-blip-characters
     with-frame-state-variables))
@@ -2982,7 +3043,6 @@
     compile-time-property
     convert-to-device-coordinates
     convert-to-device-distances
-    coordinate
     define-class-mixture
     define-constructor
     define-constructor-using-prototype-instance
@@ -3003,8 +3063,7 @@
     gensymbol 
     get-compile-time-local-property
     ignore-arglist
-    integerize-coordinate
-    integerize-coordinates
+    +largest-coordinate+
     lambda-list-variables-used-in-body
     letf-globally
     letf-globally-if
@@ -3114,15 +3173,15 @@
     bounding-rectangle-position-difference
     bounding-rectangle-position-equal
     bounding-rectangle-set-edges
-    bounding-rectangle-set-position*
+    bounding-rectangle-set-position
     bounding-rectangle-set-size
     bounding-rectangle-shift-position
     bounding-rectangle-size-equal
-    position-difference*
+    position-difference
 
     ;; LTRBs
     ltrb-contains-ltrb-p
-    ltrb-contains-point*-p
+    ltrb-contains-position-p
     ltrb-difference
     ltrb-equals-ltrb-p
     ltrb-intersection
@@ -3196,31 +3255,24 @@
 
   (:export
     *all-drawing-options*
-    *default-text-style*
     *modifier-keys*
     *null-text-style*
     *pointer-buttons*
     *standard-character-set* 
     *undefined-text-style* 
     +highlighting-line-style+
-    action-gadget
     activate-gadget-event
     add-sheet-callbacks
     all-drawing-options-lambda-list
-    allocate-medium
-    bboard-pane
-    border-pane
     bury-mirror
     canvas
-    change-scrollbar-values
+    change-scroll-bar-values
     char-character-set-and-index
     char-width
     clear-space-requirement-caching-in-ancestors
     clear-space-requirement-caches-in-tree
     click-event
     client-overridability
-    command-menu-pane
-    deallocate-medium
     default-space-requirements
     define-character-face
     define-character-face-added-mappings
@@ -3229,30 +3281,18 @@
     define-graphics-function
     define-text-style-mappings
     define-text-style-mappings-1 
-    degraft-medium
     diacritic-char-p
     display-device 
-    engraft-medium
-    event
-    event-modifier-key-state
     find-port-type
     fit-region*-in-region*
-    frame-manager-frames
     frame-shell
     frame-wrapper
-    gadget-activate-callback
-    gadget-armed-callback
-    gadget-disarmed-callback
-    gadget-value-changed-callback
     get-drawing-function-description
     get-port-canonical-gesture-spec
     grid-pane
-    hbox-pane
-    hrack-pane
     intern-text-style
     invoke-callback-function
     label-button-pane
-    labelled-gadget
     line-editor-pane
     list-pane
     make-frame-manager
@@ -3272,10 +3312,7 @@
     move-sheet*
     mute-repainting-mixin
     non-drawing-option-keywords
-    oriented-gadget
     one-of-pane
-    outlined-pane
-    pane-scroller
     parse-gesture-spec
     permanent-medium-sheet-output-mixin
     pointer-press-event
@@ -3296,23 +3333,16 @@
     port-modifier-state
     port-note-cursor-change
     port-pointer
-    port-server-path
-    port-type
     port-undefined-text-style
     port-write-char-1
     port-write-string-1
     process-event-locally
-    push-button-pane
-    radio-box-pane
     radio-button-pane
-    restraining-pane
     raise-mirror
     resize-sheet*
-    scrollbar-value-changed-callback
-    scroll-bar-pane
     scroll-extent
     scrollable-pane
-    scroller-pane
+    scroll-bar-value-changed-callback
     set-sheet-mirror-edges*
     shadow-pane
     sheet-actual-native-edges*
@@ -3321,10 +3351,8 @@
     sheet-shell
     sheet-top-level-mirror
     sheet-with-graphics-state
-    slider-pane
     space-requirement-components
     space-requirement-mixin
-    spacing-pane
     standard-sheet
     standard-sheet-input-mixin
     standardize-text-style 
@@ -3334,21 +3362,14 @@
     stream-write-string-1
     string-height 
     string-width 
-    table-pane
-    text-field-pane
     text-style-scale 
-    toggle-button-pane
     transform-distances
-    transform-point-sequence
-    transform-points
+    transform-position-sequence
+    transform-positions
     update-region
-    update-scrollbars
+    update-scroll-bars
     value-changed-gadget-event
-    value-gadget
-    vbox-pane
     viewport-region-changed
-    viewport-viewport-region
-    vrack-pane
     window-configuration-event
     window-repaint-event
     window-shift-visible-region))
diff --git a/utils/region-arithmetic.lisp b/utils/region-arithmetic.lisp
index d3330eaf..b015b5b3 100644
--- a/utils/region-arithmetic.lisp
+++ b/utils/region-arithmetic.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: region-arithmetic.lisp,v 1.4 92/03/04 16:20:22 cer Exp $
+;; $fiHeader: region-arithmetic.lisp,v 1.5 92/03/10 10:11:59 cer Exp $
 
 (in-package :clim-utils)
 
@@ -193,7 +193,7 @@
   (and (= (- right1 left1) (- right2 left2))
        (= (- bottom1 top1) (- bottom2 top2))))
 
-(defun ltrb-contains-point*-p (left top right bottom x y)
+(defun ltrb-contains-position-p (left top right bottom x y)
   (declare (type coordinate left top right bottom x y))
   (and (<= left x)
        (<= top y)
diff --git a/utils/regions.lisp b/utils/regions.lisp
index aa1a5362..2df2fa2e 100644
--- a/utils/regions.lisp
+++ b/utils/regions.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: regions.lisp,v 1.4 92/02/24 13:05:57 cer Exp $
+;; $fiHeader: regions.lisp,v 1.5 92/03/04 16:20:23 cer Exp $
 
 (in-package :clim-utils)
 
@@ -11,14 +11,14 @@
 (defgeneric transform-region (transformation region))
 (defgeneric untransform-region (transformation region))
 
-(defgeneric point-position* (point)
+(defgeneric point-position (point)
   (declare (values x y)))
 (defgeneric point-x (point))
 (defgeneric point-y (point))
 
 ;;--- Many of these methods could stand to be written...
 (defgeneric region-equal (region1 region2))
-(defgeneric region-contains-point*-p (region x y))
+(defgeneric region-contains-position-p (region x y))
 (defgeneric region-contains-region-p (region1 region2))
 (defgeneric region-intersects-region-p (region1 region2))
 
@@ -69,7 +69,7 @@
   (declare (values left top right bottom)))
 (defgeneric bounding-rectangle-set-edges (region left top right bottom)
   (declare (values region)))
-(defgeneric bounding-rectangle-set-position* (region x y)
+(defgeneric bounding-rectangle-set-position (region x y)
   (declare (values region)))
 (defgeneric bounding-rectangle-set-size (region width height)
   (declare (values region)))
@@ -79,19 +79,11 @@
      (defmethod ,name (,region1 ,region2) ,@body)
      (defmethod ,name (,region2 ,region1) ,@body)))
 
-#-Silica
 (defmacro fix-rectangle (left top right bottom)
-  `(values (the fixnum (floor ,left))
-	   (the fixnum (floor ,top))
-	   (the fixnum (ceiling ,right))
-	   (the fixnum (ceiling ,bottom))))
-
-#+Silica
-(defmacro fix-rectangle (left top right bottom)
-  `(values (float ,left 0f0)
-	   (float ,top 0f0)
-	   (float ,right 0f0)
-	   (float ,bottom 0f0)))
+  `(values (the coordinate (coordinate ,left 'floor))
+	   (the coordinate (coordinate ,top  'floor))
+	   (the coordinate (coordinate ,right  'ceiling))
+	   (the coordinate (coordinate ,bottom 'ceiling))))
 
 
 ;;; The basic design protocol classes
@@ -119,10 +111,6 @@
 
 (define-protocol-class region (design))
 
-(defmethod transform-region ((transformation identity-transformation) region) region)
-
-(defmethod untransform-region ((transformation identity-transformation) region) region)
-
 (defmethod untransform-region ((transformation transformation) region)
   (transform-region (invert-transformation transformation) region))
 
@@ -136,7 +124,7 @@
 
 (defmethod region-equal ((nowhere1 nowhere) (nowhere2 nowhere)) t)
 
-(defmethod region-contains-point*-p ((nowhere nowhere) x y)
+(defmethod region-contains-position-p ((nowhere nowhere) x y)
   (declare (ignore x y))
   nil)
 
@@ -166,7 +154,7 @@
 
 (defmethod region-equal ((everywhere1 everywhere) (everywhere2 everywhere)) t)
 
-(defmethod region-contains-point*-p ((everywhere everywhere) x y) 
+(defmethod region-contains-position-p ((everywhere everywhere) x y) 
   (declare (ignore x y))
   t)
 
@@ -212,16 +200,21 @@
   (with-slots (x y) point
     `(make-point ,x ,y)))
 
-(defmethod point-position* ((point standard-point))
+(defmethod point-position ((point standard-point))
   (with-slots (x y) point
     (values x y)))
 
+#+CLIM-1-compatibility
+(define-compatibility-function (point-position* point-position)
+			       (point)
+  (point-position point))
+
 (defmethod region-equal ((point1 standard-point) (point2 standard-point))
   (with-slots ((x1 x) (y1 y)) point1
     (with-slots ((x2 x) (y2 y)) point2
       (and (= x1 x2) (= y1 y2)))))
 
-(defmethod region-contains-point*-p ((point standard-point) x y)
+(defmethod region-contains-position-p ((point standard-point) x y)
   (with-slots ((px x) (py y)) point
     (and (= px x) (= py y))))
 
@@ -232,7 +225,7 @@
 
 (defmethod region-contains-region-p ((region region) (point standard-point))
   (with-slots (x y) point
-    (region-contains-point*-p region x y)))
+    (region-contains-position-p region x y)))
 
 (defmethod region-intersects-region-p ((point1 standard-point) (point2 standard-point))
   (with-slots ((x1 x) (y1 y)) point1
@@ -242,7 +235,7 @@
 (define-symmetric-region-method region-intersects-region-p
 				((point standard-point) (region region))
   (with-slots ((px x) (py y)) point
-    (region-contains-point*-p region px py)))
+    (region-contains-position-p region px py)))
 
 (defmethod region-intersection ((point1 standard-point) (point2 standard-point))
   (with-slots ((x1 x) (y1 y)) point1
@@ -252,7 +245,7 @@
 (defmethod transform-region (transformation (point standard-point))
   (with-slots (x y) point
     (multiple-value-bind (x y)
-	(transform-point* transformation x y)
+	(transform-position transformation x y)
       (make-point-1 x y))))
 
 (defmethod bounding-rectangle* ((point standard-point))
@@ -303,8 +296,8 @@
   :min-x min-x :min-y min-y :max-x max-x :max-y max-y :points points)
 
 (defun make-rectangle (min-point max-point)
-  (multiple-value-bind (min-x min-y) (point-position* min-point)
-    (multiple-value-bind (max-x max-y) (point-position* max-point)
+  (multiple-value-bind (min-x min-y) (point-position min-point)
+    (multiple-value-bind (max-x max-y) (point-position max-point)
       (assert (<= min-x max-x))
       (assert (<= min-y max-y))
       (make-rectangle-1 min-x min-y max-x max-y
@@ -375,9 +368,9 @@
       (ltrb-equals-ltrb-p sx1 sy1 ex1 ey1
 			  sx2 sy2 ex2 ey2))))
 
-(defmethod region-contains-point*-p ((rectangle standard-rectangle) x y)
+(defmethod region-contains-position-p ((rectangle standard-rectangle) x y)
   (with-slots (min-x min-y max-x max-y) rectangle
-    (ltrb-contains-point*-p min-x min-y max-x max-y x y)))
+    (ltrb-contains-position-p min-x min-y max-x max-y x y)))
 
 (defmethod region-contains-region-p ((rect1 standard-rectangle) (rect2 standard-rectangle))
   (with-slots ((sx1 min-x) (sy1 min-y) (ex1 max-x) (ey1 max-y)) rect1
@@ -395,14 +388,14 @@
   (with-slots (min-x min-y max-x max-y) rectangle
     (if (rectilinear-transformation-p transformation)
 	(multiple-value-bind (x1 y1)
-	    (transform-point* transformation min-x min-y)
+	    (transform-position transformation min-x min-y)
 	  (multiple-value-bind (x2 y2)
-	      (transform-point* transformation max-x max-y)
+	      (transform-position transformation max-x max-y)
 	    (make-rectangle* x1 y1 x2 y2)))
       (let ((coords nil))
 	(flet ((transform-coord (x y)
 		 (multiple-value-bind (nx ny)
-		     (transform-point* transformation x y)
+		     (transform-position transformation x y)
 		   (push ny coords)
 		   (push nx coords))))
 	  (declare (dynamic-extent #'transform-coord))
@@ -429,10 +422,10 @@
 ;;--- Can we simply inherit from STANDARD-RECTANGLE and flush some
 ;;--- of the methods below?
 (defclass standard-bounding-rectangle (region bounding-rectangle)
-    ((left   :initarg :left   :accessor rectangle-min-x)
-     (top    :initarg :top    :accessor rectangle-min-y)
-     (right  :initarg :right  :accessor rectangle-max-x)
-     (bottom :initarg :bottom :accessor rectangle-max-y)))
+    ((left   :initarg :left   :accessor rectangle-min-x :type coordinate)
+     (top    :initarg :top    :accessor rectangle-min-y :type coordinate)
+     (right  :initarg :right  :accessor rectangle-max-x :type coordinate)
+     (bottom :initarg :bottom :accessor rectangle-max-y :type coordinate)))
 
 (defmethod print-object ((object standard-bounding-rectangle) stream)
   (print-unreadable-object (object stream :type t :identity t)
@@ -446,12 +439,11 @@
 		    (left top right bottom)
   :left left :top top :right right :bottom bottom)
 
-#-Silica
 (defun make-bounding-rectangle (x1 y1 x2 y2)
-  (let ((x1 (floor x1))
-	(y1 (floor y1))
-	(x2 (floor x2))
-	(y2 (floor y2)))
+  (let ((x1 (coordinate x1))
+	(y1 (coordinate y1))
+	(x2 (coordinate x2))
+	(y2 (coordinate y2)))
     (declare (type coordinate x1 y1 x2 y2))
     (when (> x1 x2) (rotatef x1 x2))
     (when (> y1 y2) (rotatef y1 y2))
@@ -526,9 +518,9 @@
       (ltrb-equals-ltrb-p sx1 sy1 ex1 ey1
 			  sx2 sy2 ex2 ey2))))
 
-(defmethod region-contains-point*-p ((rectangle standard-bounding-rectangle) x y)
+(defmethod region-contains-position-p ((rectangle standard-bounding-rectangle) x y)
   (with-slots (left top right bottom) rectangle
-    (ltrb-contains-point*-p left top right bottom x y)))
+    (ltrb-contains-position-p left top right bottom x y)))
 
 (defmethod region-contains-region-p ((rect1 standard-bounding-rectangle) 
 				     (rect2 standard-bounding-rectangle))
@@ -569,6 +561,7 @@
 
 ;; Set the edges of the rectangle, and return the rectangle as the value
 ;; LEFT, TOP, RIGHT, and BOTTOM had better be of type COORDINATE
+;;--- Or should this coerce to COORDINATE?
 (defmethod bounding-rectangle-set-edges ((rectangle standard-bounding-rectangle)
 					 left top right bottom)
   (declare (type coordinate left top right bottom))
@@ -627,18 +620,13 @@
     (declare (ignore min-x min-y))
     (make-point max-x max-y)))
 
-(defun-inline bounding-rectangle-position* (region)
+(defun-inline bounding-rectangle-position (region)
   (with-bounding-rectangle* (left top right bottom) region 
     (declare (ignore right bottom))
     (values left top)))
 
-(defun bounding-rectangle-position (region)
-  (with-bounding-rectangle* (left top right bottom) region 
-    (declare (ignore right bottom))
-    (make-point left top)))
-
 ;; Set the position of the rectangle, and return the rectangle as the value
-(defmethod bounding-rectangle-set-position* ((rectangle standard-bounding-rectangle) x y)
+(defmethod bounding-rectangle-set-position ((rectangle standard-bounding-rectangle) x y)
   (declare (type coordinate x y))
   (with-slots (left top right bottom) rectangle
     (declare (type coordinate left top right bottom))
@@ -651,6 +639,18 @@
 	    bottom (+ y  height))))
   rectangle)
 
+#+CLIM-1-compatibility
+(define-compatibility-function (bounding-rectangle-position*
+				bounding-rectangle-position)
+			       (region)
+  (bounding-rectangle-position region))
+
+#+CLIM-1-compatibility
+(define-compatibility-function (bounding-rectangle-set-position* 
+				bounding-rectangle-set-position)
+			       (region x y)
+  (bounding-rectangle-set-position region))
+
 ;; Make a new bounding rectangle for the region, and shift its position by DX,DY,
 ;; and return the new rectangle.
 (defun bounding-rectangle-shift-position (region dx dy &optional reuse-rectangle)
@@ -666,9 +666,9 @@
     rectangle))
 
 (defun bounding-rectangle-position-equal (region1 region2)
-  (multiple-value-bind (x1 y1) (bounding-rectangle-position* region1)
+  (multiple-value-bind (x1 y1) (bounding-rectangle-position region1)
     (declare (type coordinate x1 y1))
-    (multiple-value-bind (x2 y2) (bounding-rectangle-position* region2)
+    (multiple-value-bind (x2 y2) (bounding-rectangle-position region2)
       (declare (type coordinate x2 y2))
       (and (= x1 x2)
 	   (= y1 y2)))))
@@ -682,16 +682,16 @@
 	   (= bottom1 bottom2)))))
 
 ;; This should only be used to compare COORDINATEs
-(defun-inline position-difference* (x1 y1 x2 y2)
+(defun-inline position-difference (x1 y1 x2 y2)
   (declare (type coordinate x1 y1 x2 y2))
   (values (- x1 x2) (- y1 y2)))
 
 (defun bounding-rectangle-position-difference (region1 region2)
-  (multiple-value-bind (x1 y1) (bounding-rectangle-position* region1)
+  (multiple-value-bind (x1 y1) (bounding-rectangle-position region1)
     (declare (type coordinate x1 y1))
-    (multiple-value-bind (x2 y2) (bounding-rectangle-position* region2)
+    (multiple-value-bind (x2 y2) (bounding-rectangle-position region2)
       (declare (type coordinate x2 y2))
-      (position-difference* x1 y1 x2 y2))))
+      (position-difference x1 y1 x2 y2))))
 
 (defun-inline bounding-rectangle-width (region)
   (with-bounding-rectangle* (left top right bottom) region
@@ -795,12 +795,12 @@
   ;;--- How to do this?
   )
 
-(defmethod region-contains-point*-p ((region-set region-set) x y)
-  (flet ((contains-point*-p (region)
-	   (when (region-contains-point*-p region x y)
-	     (return-from region-contains-point*-p t))))
-    (declare (dynamic-extent #'contains-point*-p))
-    (map-over-region-set-regions #'contains-point*-p region-set))
+(defmethod region-contains-position-p ((region-set region-set) x y)
+  (flet ((contains-position-p (region)
+	   (when (region-contains-position-p region x y)
+	     (return-from region-contains-position-p t))))
+    (declare (dynamic-extent #'contains-position-p))
+    (map-over-region-set-regions #'contains-position-p region-set))
   nil)
 
 (defmethod region-contains-region-p ((region-set region-set) (other-region region))
diff --git a/utils/transformations.lisp b/utils/transformations.lisp
index 04b6af6e..d471d84d 100644
--- a/utils/transformations.lisp
+++ b/utils/transformations.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: transformations.lisp,v 1.3 92/02/24 13:05:59 cer Exp $
+;; $fiHeader: transformations.lisp,v 1.4 92/03/04 16:20:26 cer Exp $
 
 (in-package :clim-utils)
 
@@ -25,9 +25,9 @@
 (defgeneric compose-scaling-with-transformation (transform mx my &optional origin))
 (defgeneric compose-rotation-with-transformation (transform angle &optional origin))
 
-(defgeneric transform-point* (transform x y)
+(defgeneric transform-position (transform x y)
   (declare (values x y)))
-(defgeneric untransform-point* (transform x y)
+(defgeneric untransform-position (transform x y)
   (declare (values x y)))
 
 (defgeneric transform-distance (transform dx dy)
@@ -682,10 +682,10 @@
 
 ;;; Transforming and untransforming of points
 
-(defmethod transform-point* ((transform identity-transformation) x y)
+(defmethod transform-position ((transform identity-transformation) x y)
   (values x y))
 
-(defmethod transform-point* ((transform translation-transformation) x y)
+(defmethod transform-position ((transform translation-transformation) x y)
   (declare (type real x y))
   (let ((x (float x 0f0))
 	(y (float y 0f0)))
@@ -694,7 +694,7 @@
       (declare (type single-float tx ty))
       (values (+ x tx) (+ y ty)))))
 
-(defmethod transform-point* ((transform standard-transformation) x y)
+(defmethod transform-position ((transform standard-transformation) x y)
   (declare (type real x y))
   (let ((x (float x 0f0))
 	(y (float y 0f0)))
@@ -704,11 +704,16 @@
       (values (+ (* x mxx) (* y mxy) tx)
 	      (+ (* x myx) (* y myy) ty)))))
 
+#+CLIM-1-compatibility
+(define-compatibility-function (transform-point* transform-position)
+			       (transform x y)
+  (transform-position transform x y))
 
-(defmethod untransform-point* ((transform identity-transformation) x y)
+
+(defmethod untransform-position ((transform identity-transformation) x y)
   (values x y))
 
-(defmethod untransform-point* ((transform translation-transformation) x y)
+(defmethod untransform-position ((transform translation-transformation) x y)
   (declare (type real x y))
   (let ((x (float x 0f0))
 	(y (float y 0f0)))
@@ -717,9 +722,14 @@
       (declare (type single-float tx ty))
       (values (- x tx) (- y ty)))))
 
-(defmethod untransform-point* ((transform standard-transformation) x y)
+(defmethod untransform-position ((transform standard-transformation) x y)
   (declare (type real x y))
-  (transform-point* (slot-value transform 'inverse) x y))
+  (transform-position (slot-value transform 'inverse) x y))
+
+#+CLIM-1-compatibility
+(define-compatibility-function (untransform-point* untransform-position)
+			       (transform x y)
+  (transform-position transform x y))
 
 
 ;;; Transforming and untransforming of distances
diff --git a/utils/utilities.lisp b/utils/utilities.lisp
index 618e8bb4..5a2fe80f 100644
--- a/utils/utilities.lisp
+++ b/utils/utilities.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: utilities.lisp,v 1.3 92/02/24 13:06:01 cer Exp $
+;; $fiHeader: utilities.lisp,v 1.4 92/03/04 16:20:27 cer Exp $
 
 ;;;
 ;;; Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved. 
@@ -56,18 +56,18 @@
 	   #+Allegro `(let ((temp ,array))
 			(etypecase temp
 			  (simple-vector temp)
-			  ((vector t) (let ((temp2 (excl::ah_data temp)))
-					(setq temp2 (if (consp temp2)
-							(cdr temp2)
-						      temp2))
-					(assert (and 
-						  (zerop (the fixnum
-							      (excl::ah_displacement temp)))
-						  (typep temp2 'simple-vector))
-						()
-						"Arrays passed to ~S must be non-displaced"
-						'with-fast-vector-references)
-					temp2))))
+			  ((vector t)
+			   (let ((temp2 (excl::ah_data temp)))
+			     (setq temp2 (if (consp temp2)
+					     (cdr temp2)
+					     temp2))
+			     (assert (and 
+				       (zerop (the fixnum (excl::ah_displacement temp)))
+				       (typep temp2 'simple-vector))
+				     ()
+				     "Arrays passed to ~S must be non-displaced"
+				     'with-fast-vector-references)
+			     temp2))))
 	   #+Genera array
 	   #-(or Allegro Genera) array)
 	 (internal-binding-declarations (variables)
diff --git a/xlib/ffi.lisp b/xlib/ffi.lisp
index 83fcaa1d..8afdd297 100644
--- a/xlib/ffi.lisp
+++ b/xlib/ffi.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ffi.lisp,v 1.8 92/03/24 19:37:20 cer Exp Locker: cer $
+;; $fiHeader: ffi.lisp,v 1.9 92/03/30 17:52:16 cer Exp $
 
 (in-package :x11)
 
@@ -93,9 +93,23 @@
       (:pointer `(* ,(second type)))
       (:array
        (destructuring-bind
-	   (ignore type indicies) type
-	 (declare (ignore ignore))
-	 `(,@indicies ,type))))))
+	  (ignore type indicies) type
+	(declare (ignore ignore))
+	`(,@indicies ,type))))))
+
+#+ignore
+(defmacro def-exported-foreign-function ((name &rest options) &rest args)
+  `(foreign-functions:defforeign 
+       ',name 
+       :arguments ',(mapcar #'(lambda (x) x t) args)
+       :call-direct t
+       :callback nil
+       :arg-checking nil
+       :return-type 'integer
+       :entry-point ,(second (assoc :name options))))
+
+
+;;; Delay version
 
 (defun trans-arg-type (type)
   (excl:if* (consp type)
@@ -126,20 +140,6 @@
 	    (:signed-32bit :integer)
 	    (t :unsigned-integer))))
   
-#+ignore
-(defmacro def-exported-foreign-function ((name &rest options) &rest args)
-  `(foreign-functions:defforeign 
-       ',name 
-       :arguments ',(mapcar #'(lambda (x) x t) args)
-       :call-direct t
-       :callback nil
-       :arg-checking nil
-       :return-type 'integer
-       :entry-point ,(second (assoc :name options))))
-
-
-;;; Delay version
-
 (defmacro def-exported-foreign-function ((name &rest options) &rest args)
   `(progn
      (eval-when (eval load compile)
diff --git a/xlib/xlib-defs.lisp b/xlib/xlib-defs.lisp
index 61114e44..991c384f 100644
--- a/xlib/xlib-defs.lisp
+++ b/xlib/xlib-defs.lisp
@@ -1,5 +1,5 @@
 ;; -*- mode: common-lisp; package: x11 -*-
-;;; (c) Copyright  1990 Sun Microsystems, Inc.  All Rights Reserved.
+;; (c) Copyright  1990 Sun Microsystems, Inc.  All Rights Reserved.
 ;; 
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca.  All rights reserved.
 ;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca.  All rights reserved.
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;;; $fiHeader$
+;;; $fiHeader: xlib-defs.lisp,v 1.1 92/03/06 17:06:59 cer Exp $
 
 (in-package :x11)
 
diff --git a/xlib/xlib-funs.lisp b/xlib/xlib-funs.lisp
index 11a7a261..5d77f694 100644
--- a/xlib/xlib-funs.lisp
+++ b/xlib/xlib-funs.lisp
@@ -1,5 +1,5 @@
 ;; -*- mode: common-lisp; package: x11 -*-
-;;; (c) Copyright  1990 Sun Microsystems, Inc.  All Rights Reserved.
+;; (c) Copyright  1990 Sun Microsystems, Inc.  All Rights Reserved.
 ;; 
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca.  All rights reserved.
 ;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca.  All rights reserved.
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;;; $fiHeader: xlib-funs.lisp,v 1.2 92/03/24 19:37:22 cer Exp Locker: cer $
+;;; $fiHeader: xlib-funs.lisp,v 1.3 92/03/30 17:52:19 cer Exp $
 
 (in-package :x11)
 
-- 
GitLab