diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index 5e2c2d9342c6240009042742410f170e16763954..52a6e2945441e8abd567a10cd5adb0eec9be1c00 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.42 92/11/09 10:54:03 cer Exp $
+;; $fiHeader: accept-values.lisp,v 1.43 92/11/09 19:54:44 cer Exp $
 
 (in-package :clim-internals)
 
@@ -1283,3 +1283,46 @@
 		     :x 0 :y 0
 		     :modifier-state 0
 		     :button +pointer-left-button+)))))))))
+
+;;--- It seems a little bizarre having a prompt argument but
+;;--- is there a better way.
+
+(defmethod stream-present ((stream accept-values-stream) object presentation-type 
+							 &rest present-args
+							 &key view
+							 (prompt nil prompt-p)
+							 (query-identifier nil))
+
+  (declare (ignore prompt))
+  (unless prompt-p (return-from stream-present (call-next-method)))
+
+  (flet ((do-ppresent (stream)
+	   (updating-output
+	       (stream :unique-id query-identifier
+		       :id-test #'equal
+		       :cache-value object
+		       :cache-test #'equal)
+	       stream
+	     ;;--- We did this because (sequence integer) reinvoked
+	     ;;--- present with the prompt for each of components of
+	     ;;--- the stream. so we end up back here and create badly
+	     ;;--- identified updating-output records.
+	     (apply #'stream-present (encapsulating-stream-stream stream)
+		    object presentation-type present-args))))
+    (declare (dynamic-extent #'do-ppresent))
+    (let ((align-prompts (slot-value stream 'align-prompts)))
+      (cond (align-prompts
+	     ;; The user has asked to line up the labels, so oblige him
+	     (formatting-row (stream)
+		 (formatting-cell (stream :align-x align-prompts)
+		     (setq query-identifier 
+		       (apply #'prompt-for-accept
+			      (encapsulated-stream stream) presentation-type view present-args)))
+	       (formatting-cell (stream :align-x :left)
+		   (do-ppresent stream))))
+	    (t
+	     (setq query-identifier
+	       (apply #'prompt-for-accept
+		      (encapsulated-stream stream) presentation-type view present-args))
+	     (do-ppresent stream)))))
+  (values object))
diff --git a/clim/activities.lisp b/clim/activities.lisp
index b6b36cf11d1164c8f5fafe87a209d3e1a2462046..880c730e3deb1258d6b8c961f15f32acd3643b46 100644
--- a/clim/activities.lisp
+++ b/clim/activities.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: activities.lisp,v 1.4 92/10/29 15:02:39 cer Exp $
+;; $fiHeader: activities.lisp,v 1.5 92/11/06 18:59:00 cer Exp $
 
 (in-package :clim-internals)
 
@@ -183,7 +183,9 @@
       (select-activity-active-frame activity frame))))
 
 (defmethod activity-frame-window-select :around ((activity-frame activity-frame))
-  (unless (eq activity-frame (activity-active-frame (frame-activity activity-frame)))
+  (unless (let ((activity (frame-activity activity-frame)))
+	    (and activity
+		 (eq activity-frame (activity-active-frame activity))))
     (call-next-method)))
 
 (defun select-activity-active-frame (activity frame)
diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp
index ce859ae5bc7e95dd2320263859377d04c33bc1a7..a16b0ef0138e7245ebdeac078ace1b013a343f6d 100644
--- a/clim/gadget-output.lisp
+++ b/clim/gadget-output.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gadget-output.lisp,v 1.37 92/11/09 10:54:34 cer Exp $
+;; $fiHeader: gadget-output.lisp,v 1.38 92/11/09 19:54:54 cer Exp $
 
 (in-package :clim-internals)
 
@@ -106,13 +106,7 @@
 	    (output-record-stream record) (output-record-parent record))
 	(with-bounding-rectangle* (left top right bottom) record
 	  (translate-positions xoff yoff left top right bottom)
-	  (with-bounding-rectangle* (gleft gtop gright gbottom) gadget
-	    (unless (and (= left gleft)
-			 (= top  gtop)
-			 (= right  gright)
-			 (= bottom gbottom))
-	      (move-and-resize-sheet gadget
-				     left top (- right left) (- bottom top)))))))))
+	  (move-and-resize-sheet gadget left top (- right left) (- bottom top)))))))
 
 ;;--- Flush this when REPLAY-OUTPUT-RECORD calls itself recursively
 (defmethod note-output-record-replayed ((record gadget-output-record) stream
@@ -278,11 +272,13 @@
 ;;; Completion gadget
 
 (define-presentation-method decode-indirect-view
-			    ((type completion) (view gadget-dialog-view)
-			     (framem standard-frame-manager) &key)
+    ((type completion) (view gadget-dialog-view)
+		       (framem standard-frame-manager) &key read-only)
   ;;--- We can be clever and return different views depending on the
   ;;--- number of items, etc.
-  +radio-box-view+)
+  (if read-only
+      (call-next-method)
+    +radio-box-view+))
 
 ;(define-presentation-method gadget-includes-prompt-p 
 ;			    ((type completion) (stream t) (view radio-box-view))
@@ -362,9 +358,11 @@
 ;;; Subset completion gadget
 
 (define-presentation-method decode-indirect-view
-			    ((type subset-completion) (view gadget-dialog-view)
-			     (framem standard-frame-manager) &key)
-  +check-box-view+)
+    ((type subset-completion) (view gadget-dialog-view)
+			      (framem standard-frame-manager) &key read-only)
+  (if read-only
+      (call-next-method)
+    +check-box-view+))
 
 ;(define-presentation-method gadget-includes-prompt-p 
 ;			    ((type subset-completion) (stream t) (view check-box-view))
@@ -446,9 +444,11 @@
 ;;; Boolean gadget
 
 (define-presentation-method decode-indirect-view
-			    ((type boolean) (view gadget-dialog-view)
-			     (framem standard-frame-manager) &key)
-  +toggle-button-view+)
+    ((type boolean) (view gadget-dialog-view)
+		    (framem standard-frame-manager) &key read-only)
+  (if read-only
+      (call-next-method)
+    +toggle-button-view+))
 
 (define-presentation-method gadget-includes-prompt-p 
 			    ((type boolean) (stream t) (view toggle-button-view))
@@ -486,10 +486,25 @@
   t)
 
 (define-presentation-method accept-present-default 
-			    ((type real) stream (view slider-view)
-			     default default-supplied-p present-p query-identifier
-			     &key  (prompt t) (active-p t))
+    ((type real) stream (view slider-view)
+		 default default-supplied-p present-p query-identifier
+		 &key  (prompt t) (active-p t))
   (declare (ignore present-p))
+  (make-real-gadget-for-slider-view stream view active-p default
+				    type prompt query-identifier
+				    low high default-supplied-p t))
+
+(define-presentation-method present
+    (object (type real) stream (view slider-view) &key acceptably query-identifier prompt)
+  (declare (ignore acceptably))
+  (make-real-gadget-for-slider-view stream view t object
+				    type prompt query-identifier
+				    low high t nil))
+
+(defun make-real-gadget-for-slider-view (stream view active-p default
+					 type prompt query-identifier
+					 low high default-supplied-p
+					       &optional (editable-p t))
   (move-cursor-to-view-position stream view)
   (let ((min-value (if (eq low '*) 0 low))
 	(max-value (if (eq high '*) 100 high)))
@@ -505,24 +520,41 @@
 	(let ((slider 
 		;;--- What other initargs do we pass along from the view?
 		(make-pane-from-view 'slider view
-		  :label (and (stringp prompt) prompt)
-		  :value (if default-supplied-p default min-value)
-		  :min-value min-value :max-value max-value
-		  :orientation (gadget-orientation view)
-		  :decimal-places (slider-decimal-places view)
-		  :show-value-p (gadget-show-value-p view)
-		  :client stream :id query-identifier
-		  :value-changed-callback
-		    (make-accept-values-value-changed-callback
-		     stream query-identifier)
-		    :active active-p)))
+				     :label (and (stringp prompt) prompt)
+				     :value (if default-supplied-p default min-value)
+				     :min-value min-value :max-value max-value
+				     :orientation (gadget-orientation view)
+				     :decimal-places (or (slider-decimal-places view) 0)
+				     :show-value-p (gadget-show-value-p view)
+				     :client stream :id query-identifier
+				     :value-changed-callback
+				     (and editable-p
+					  (make-accept-values-value-changed-callback
+					   stream query-identifier))
+				     :active active-p
+				     :editable-p editable-p)))
 	  (values (outlining () slider) slider))))))
 
 (define-presentation-method accept-present-default 
-			    ((type integer) stream (view slider-view)
-			     default default-supplied-p present-p query-identifier
-			     &key  (prompt t) (active-p t))
+    ((type integer) stream (view slider-view)
+		    default default-supplied-p present-p query-identifier
+		    &key  (prompt t) (active-p t))
   (declare (ignore present-p))
+  (make-integer-gadget-for-slider-view stream view active-p default
+				       type prompt query-identifier
+				       low high default-supplied-p t))
+
+(define-presentation-method present
+    (object (type integer) stream (view slider-view) &key acceptably query-identifier prompt)
+  (declare (ignore acceptably))
+  (make-integer-gadget-for-slider-view stream view t object
+				    type prompt query-identifier
+				    low high t nil))
+
+(defun make-integer-gadget-for-slider-view (stream view active-p default
+					    type prompt query-identifier
+					    low high default-supplied-p
+					    &optional (editable-p t))
   (move-cursor-to-view-position stream view)
   (let ((min-value (if (eq low '*) 0 low))
 	(max-value (if (eq high '*) 100 high)))
@@ -536,45 +568,75 @@
 		   (if default-supplied-p default min-value))))
       (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
 	(let ((slider
-		;;--- What other initargs do we pass along from the view?
-		(make-pane-from-view 'slider view
-		  :label (and (stringp prompt) prompt)
-		  :value (if default-supplied-p default min-value)
-		  :min-value min-value :max-value max-value
-		  :orientation (gadget-orientation view)
-		  :number-of-quanta (- high low) :decimal-places 0
-		  :show-value-p (gadget-show-value-p view)
-		  :client stream :id query-identifier
-		  :value-changed-callback
-		    (make-accept-values-value-changed-callback
-		     stream query-identifier)
-		    :active active-p)))
+	       ;;--- What other initargs do we pass along from the view?
+	       (make-pane-from-view 'slider view
+				    :label (and (stringp prompt) prompt)
+				    :value (if default-supplied-p default min-value)
+				    :min-value min-value :max-value max-value
+				    :orientation (gadget-orientation view)
+				    :number-of-quanta (- max-value min-value) 
+				    :decimal-places 0
+				    :show-value-p (gadget-show-value-p view)
+				    :client stream :id query-identifier
+				    :value-changed-callback
+				    (and editable-p
+				     (make-accept-values-value-changed-callback
+				      stream query-identifier))
+				    :active active-p
+				    :editable-p editable-p)))
 	  (values (outlining () slider) slider))))))
 
 
 ;;; Text editing gadgets
 
 (define-presentation-method accept-present-default 
-			    ((type t) stream (view text-field-view)
-			     default default-supplied-p present-p query-identifier
-			     &key  (prompt t) (active-p t))
+    ((type t) stream (view text-field-view)
+	      default default-supplied-p present-p query-identifier
+	      &key  (prompt t) (active-p t))
   (declare (ignore default-supplied-p present-p))
+  (make-gadget-for-text-field-view stream view active-p default type prompt query-identifier t))
+
+;;;-- This is boring. We need a whole bunch of methods to shadow those
+;;;-- in standard-types:
+;;;-- eg..
+
+(defmacro define-present-methods-for-types (function types view)
+  `(progn
+     ,@(mapcar #'(lambda (type)
+		   `(define-presentation-method present 
+			(object (type ,type) stream (view ,view) 
+				&key acceptably query-identifier prompt)
+		      (declare (ignore acceptably))
+		      (,function 
+		       stream view t object type prompt query-identifier nil)))
+	       types)))
+
+;;;--- Should there be a method specialized on T???
+
+(define-present-methods-for-types make-gadget-for-text-field-view 
+    (real string pathname completion subset-completion sequence sequence-enumerated boolean)
+  text-field-view)
+
+(defun make-gadget-for-text-field-view (stream view active-p default type prompt query-identifier
+					       &optional (editable-p t))
   (move-cursor-to-view-position stream view)
   (flet ((update-gadget (record gadget text-field)
  	   (declare (ignore record gadget))	     ;;-- This sucks
-	     (if active-p
-		 (activate-gadget text-field)
-	       (deactivate-gadget text-field))
+	   (if active-p
+	       (activate-gadget text-field)
+	     (deactivate-gadget text-field))
  	   (setf (gadget-value text-field) (present-to-string default type))))
     (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
       (let ((text-field (make-pane-from-view 'text-field view
-			  :label (and (stringp prompt) prompt)
-			  :value (present-to-string default type)
-			  :client stream :id query-identifier
-			  :value-changed-callback
-			    `(accept-values-string-field-changed-callback
-			      ,stream ,query-identifier)
-			    :active active-p)))
+					     :label (and (stringp prompt) prompt)
+					     :value (present-to-string default type)
+					     :client stream :id query-identifier
+					     :editable-p editable-p
+					     :value-changed-callback
+					     (and editable-p
+						  `(accept-values-string-field-changed-callback
+						    ,stream ,query-identifier))
+					     :active active-p)))
  	(values text-field text-field)))))
 
 ;;--- This is mostly nonsense.  If we enter something that is an error then
@@ -599,34 +661,43 @@
 			     (framem standard-frame-manager) &key)
   +text-field-view+)
 
-(define-presentation-method accept-present-default 
-			    ((type string) stream (view text-field-view)
-			     default default-supplied-p present-p query-identifier
-			     &key  (prompt t) (active-p t))
-  (declare (ignore default-supplied-p present-p))
-  (move-cursor-to-view-position stream view)
-  (flet ((update-gadget (record gadget button)
- 	   (declare (ignore record gadget))
-	     (if active-p
-		 (activate-gadget button)
-	       (deactivate-gadget button))
- 	   (setf (gadget-value button) default)))
-    (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
-      (let ((text-field (make-pane-from-view 'text-field view
-			  :label (and (stringp prompt) prompt)
-			  :value default
-			  :client stream :id query-identifier
-			  :value-changed-callback
-			    (make-accept-values-value-changed-callback
-			     stream query-identifier)
-			    :active active-p)))
- 	(values text-field text-field)))))
+;;--- How does this differ from the default method for
+;;--- accept-present-default
+;(define-presentation-method accept-present-default 
+;			    ((type string) stream (view text-field-view)
+;			     default default-supplied-p present-p query-identifier
+;			     &key  (prompt t) (active-p t))
+;  (declare (ignore default-supplied-p present-p))
+;  (move-cursor-to-view-position stream view)
+;  (flet ((update-gadget (record gadget button)
+; 	   (declare (ignore record gadget))
+;	     (if active-p
+;		 (activate-gadget button)
+;	       (deactivate-gadget button))
+; 	   (setf (gadget-value button) default)))
+;    (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
+;      (let ((text-field (make-pane-from-view 'text-field view
+;			  :label (and (stringp prompt) prompt)
+;			  :value default
+;			  :client stream :id query-identifier
+;			  :value-changed-callback
+;			    (make-accept-values-value-changed-callback
+;			     stream query-identifier)
+;			    :active active-p)))
+; 	(values text-field text-field)))))
 
 (define-presentation-method accept-present-default 
-			    ((type string) stream (view text-editor-view)
-			     default default-supplied-p present-p query-identifier
-			     &key  (prompt t) (active-p t))
+    ((type string) stream (view text-editor-view)
+		   default default-supplied-p present-p query-identifier
+		   &key  (prompt t) (active-p t))
   (declare (ignore default-supplied-p present-p))
+  (make-gadget-for-text-editor stream view active-p default type prompt query-identifier t))
+
+(define-present-methods-for-types make-gadget-for-text-editor (string) text-editor-view)
+
+(defun make-gadget-for-text-editor (stream view active-p default type prompt query-identifier
+					       &optional (editable-p t))
+
   (move-cursor-to-view-position stream view)
   (flet ((update-gadget (record gadget button)
  	   (declare (ignore record gadget))
@@ -636,13 +707,15 @@
  	   (setf (gadget-value button) default)))
     (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
       (let ((text-field (make-pane-from-view 'text-editor view
-			  :label (and (stringp prompt) prompt)
-			  :value default
-			  :client stream :id query-identifier
-			  :value-changed-callback
-			    (make-accept-values-value-changed-callback
-			     stream query-identifier)
-			    :active active-p)))
+					     :label (and (stringp prompt) prompt)
+					     :value default
+					     :client stream :id query-identifier
+					     :value-changed-callback
+					     (and editable-p
+						  (make-accept-values-value-changed-callback
+						   stream query-identifier))
+					     :active active-p
+					     :editable-p editable-p)))
  	(values (scrolling () text-field) text-field)))))
 
 
@@ -744,4 +817,3 @@
 
 (defmethod sheet-disown-child ((stream standard-encapsulating-stream) child)
   (sheet-disown-child (encapsulating-stream-stream stream) child))
-
diff --git a/clim/present.lisp b/clim/present.lisp
index 67ace546bc5a0ba827cf143d349b5ea016775469..f7316c9fc6aa49ecc4cbcdac2e41f112afadf5ae 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.9 92/10/28 11:31:57 cer Exp $
+;; $fiHeader: present.lisp,v 1.10 92/11/06 19:00:17 cer Exp $
 
 (in-package :clim-internals)
 
@@ -8,7 +8,11 @@
 
 (defun present (object &optional (presentation-type (presentation-type-of object))
 		&rest present-args
-		&key (stream *standard-output*) &allow-other-keys)
+		&key (stream *standard-output*) 
+		     (view (stream-default-view stream))
+		     (for-context-type presentation-type)
+		     query-identifier
+		&allow-other-keys)
   (declare (dynamic-extent present-args))
   (declare (arglist object &optional (presentation-type (presentation-type-of object))
 		    &key (stream *standard-output*)
@@ -17,9 +21,34 @@
 			 (for-context-type presentation-type) (single-box nil)
 			 (allow-sensitive-inferiors *allow-sensitive-inferiors*)
 			 (sensitive *allow-sensitive-inferiors*)
-			 (record-type 'standard-presentation)))
-  (with-keywords-removed (present-args present-args '(:stream))
-    (apply #'stream-present stream object presentation-type present-args)))
+			 (record-type 'standard-presentation)
+			 prompt
+			 query-identifier))
+  
+  (multiple-value-bind (expansion expanded)
+      (expand-presentation-type-abbreviation presentation-type)
+    (when expanded
+      (when (eq for-context-type presentation-type)
+	(setq for-context-type expansion))
+      (setq presentation-type expansion)))
+  
+  (unless (eq for-context-type presentation-type)
+    (multiple-value-bind (expansion expanded)
+	(expand-presentation-type-abbreviation for-context-type)
+      (when expanded
+	(setq for-context-type expansion))))
+
+  (typecase view
+    (null)
+    (symbol (setq view (make-instance view)))
+    (cons   (setq view (apply #'make-instance view))))
+  
+  (setq view (decode-indirect-view presentation-type view (frame-manager stream)
+				   :read-only t
+				   :query-identifier query-identifier))
+
+  (with-keywords-removed (present-args present-args '(:stream :view))
+    (apply #'stream-present stream object presentation-type :view view present-args)))
 
 ;; Specialize on T since this method is good for all stream classes
 (defmethod stream-present ((stream t) object presentation-type
@@ -28,7 +57,8 @@
 				(for-context-type presentation-type) (single-box nil)
 				(allow-sensitive-inferiors *allow-sensitive-inferiors*) 
 				(sensitive *allow-sensitive-inferiors*)
-				(record-type 'standard-presentation))
+				(record-type 'standard-presentation)
+				(prompt nil prompt-p))
 
   ;; The arguments are allowed to be presentation type abbreviations
   (multiple-value-bind (expansion expanded)
@@ -61,13 +91,15 @@
 				    :single-box single-box
 				    :allow-sensitive-inferiors allow-sensitive-inferiors
 				    :record-type record-type)
-	(funcall-presentation-generic-function present
+	(apply-presentation-generic-function present
 	  object presentation-type stream view
-	  :acceptably acceptably :for-context-type for-context-type))
+	  :acceptably acceptably :for-context-type for-context-type
+	  (and prompt-p (list :prompt prompt))))
       (let ((*allow-sensitive-inferiors* allow-sensitive-inferiors))
-	(funcall-presentation-generic-function present
+	(apply-presentation-generic-function present
 	  object presentation-type stream view
-	  :acceptably acceptably :for-context-type for-context-type))))
+	  :acceptably acceptably :for-context-type for-context-type
+	  (and prompt-p (list :prompt prompt))))))
 
 (defun present-to-string (object
 			  &optional (presentation-type (presentation-type-of object))
diff --git a/clim/ptypes1.lisp b/clim/ptypes1.lisp
index ed89baa036eb217bfb3c27d7517b97e16bc8939f..b4a2fb2c83ff4b997734ec32c126b3609a628d8d 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.18 92/10/28 11:31:59 cer Exp $
+;; $fiHeader: ptypes1.lisp,v 1.19 92/11/06 19:00:20 cer Exp $
 
 (in-package :clim-internals)
 
@@ -335,6 +335,9 @@
 ;;; This hash table is keyed by the presentation type name and yields the class.
 (defvar *presentation-type-class-table* (make-hash-table))
 
+;;; Keyed by name, yields the function that translates one type specifier into another
+(defvar *presentation-type-abbreviation-table* (make-hash-table))
+
 #+CCL-2
 (defvar *presentation-class-type-table* (make-hash-table))
 
@@ -498,8 +501,7 @@
 
 ;;;; Presentation Type Abbreviations
 
-;;; Keyed by name, yields the function that translates one type specifier into another
-(defvar *presentation-type-abbreviation-table* (make-hash-table))
+
 
 ;;; Define a "macro" that expands one presentation type specifier into another
 (defmacro define-presentation-type-abbreviation (name parameters expansion &key options
diff --git a/clim/ptypes2.lisp b/clim/ptypes2.lisp
index dbfb90c05b65e5298112ad94b0916fec49194520..de5ce133630d8bb1f9cd6b7b0d5bea2f3d169c16 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.18 92/11/09 10:54:42 cer Exp $
+;; $fiHeader: ptypes2.lisp,v 1.19 92/11/09 19:55:03 cer Exp $
 
 (in-package :clim-internals)
 
@@ -501,9 +501,9 @@
   (declare (ignore presentation-type framem query-identifier))
   view)
 
-(defun decode-indirect-view (type view frame-manager &rest args &key query-identifier)
-  (declare (dynamic-extent args))
-  (declare (ignore query-identifier))
+(defun decode-indirect-view (type view frame-manager &rest args &key query-identifier read-only)
+  (declare (dynamic-extent args)
+	   (ignore query-identifier read-only))
   (apply-presentation-generic-function decode-indirect-view
     type view frame-manager args))
 
diff --git a/clim/standard-types.lisp b/clim/standard-types.lisp
index e9e31d5c3719ec23e8542bec59344db009adfbca..9ec293c945d5f8ad124a0f6a420e1360d9a20a0d 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.17 92/10/28 11:32:07 cer Exp $
+;; $fiHeader: standard-types.lisp,v 1.18 92/11/06 19:00:31 cer Exp $
 
 (in-package :clim-internals)
 
@@ -563,11 +563,11 @@
 
 (define-presentation-method accept ((type completion) stream (view textual-view) &key)
   (flet ((possibility-printer (possibility type stream)
-	   (declare (ignore type))
-	   (funcall printer 
-		    (funcall name-key (find (second possibility) sequence 
-					    :key value-key :test test))
-		    stream)))
+	   (with-output-as-presentation (stream (funcall value-key (second possibility)) type)
+	     (funcall printer 
+		      (funcall name-key (find (second possibility) sequence 
+					      :key value-key :test test))
+		      stream))))
     (declare (dynamic-extent #'possibility-printer))
     (values
       (completing-from-suggestions 
@@ -746,10 +746,11 @@
 	      (make-array 2 :initial-contents (list separator #\space)))))
     (flet ((possibility-printer (possibility type stream)
 	     (declare (ignore type))
-	     (funcall printer 
-		      (funcall name-key (find (second possibility) sequence 
-					      :key value-key :test test))
-		      stream)))
+	     (with-output-as-presentation (stream (funcall value-key (second possibility)) type)
+	       (funcall printer 
+			(funcall name-key (find (second possibility) sequence 
+						:key value-key :test test))
+			stream))))
       (declare (dynamic-extent #'possibility-printer))
       (loop
 	(let ((element
diff --git a/misc/undefinedsymbols.olit b/misc/undefinedsymbols.olit
index 2bd8b9d592c6ee8524ecde775b897dd022226024..80d6e97edab395a3330050cea2ef3a1f73745fc7 100644
--- a/misc/undefinedsymbols.olit
+++ b/misc/undefinedsymbols.olit
@@ -23,6 +23,7 @@ _flatNonexclusivesWidgetClass
 _flatWidgetClass
 _footerPanelWidgetClass
 _formWidgetClass
+_gaugeWidgetClass
 _helpWidgetClass
 _listPaneWidgetClass
 _magWidgetClass
diff --git a/misc/undefinedsymbols.xt b/misc/undefinedsymbols.xt
index 3d9d3d03fb69e2a7a859e69ab4b59a263c379dfb..856f2d7d608f6eed71e1e2114755ace35a80d90e 100644
--- a/misc/undefinedsymbols.xt
+++ b/misc/undefinedsymbols.xt
@@ -3,3 +3,4 @@ _XtGetResourceList
 _XtGetValues
 _XtSetValues
 _XtSetSensitive
+_XtLastTimestampProcessed
diff --git a/postscript/postscript-medium.lisp b/postscript/postscript-medium.lisp
index 1c6ca1f0c1f4b65413098fb03aacd7e7cd4f2c29..3f6e5bdad5474ceb7b2fd1153f378ef61b333b31 100644
--- a/postscript/postscript-medium.lisp
+++ b/postscript/postscript-medium.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: postscript-medium.lisp,v 1.7 92/10/02 15:21:16 cer Exp $
+;; $fiHeader: postscript-medium.lisp,v 1.8 92/10/28 11:33:27 cer Exp $
 
 (in-package :postscript-clim)
 
@@ -41,6 +41,7 @@
 	(dashes (line-style-dashes line-style)))
     (format printer-stream " ~D setlinewidth~%" thickness)
     (when dashes
+      (when (eq dashes t) (setq dashes '(4 4)))
       (making-ps-array (printer-stream)
         (let ((limit (length dashes)))
 	  (dotimes (i limit)
diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp
index 49920e939814999e13261e7843afde0c754070b2..46211a6e9c4333b77be329e3a7015d8b3aeb7b5e 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.37 92/10/28 11:30:48 cer Exp $
+;; $fiHeader: gadgets.lisp,v 1.38 92/11/06 19:03:51 cer Exp $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright (c) 1992 by Symbolics, Inc.  All rights reserved."
@@ -223,14 +223,16 @@
      (max-label :initarg :max-label)
      (range-label-text-style :initarg :range-label-text-style)
      (number-of-tick-marks :initarg :number-of-tick-marks)
-     (number-of-quanta :initarg :number-of-quanta))
+     (number-of-quanta :initarg :number-of-quanta)
+     (editable-p :initarg :editable-p :accessor gadget-editable-p))
   (:default-initargs :decimal-places 0
 		     :show-value-p nil
 		     :min-label nil
 		     :max-label nil
 		     :range-label-text-style *default-slider-range-label-text-style*
 		     :number-of-tick-marks 0
-		     :number-of-quanta nil))
+		     :number-of-quanta nil
+		     :editable-p t))
 
 (defmethod initialize-instance :after ((pane slider) 
 				       &key (decimal-places 0 places-p)
@@ -403,9 +405,12 @@
 
 ;;; Text edit
 ;;--- Do we want to specify a binding to commands?
+
 (defclass text-field 
-	  (value-gadget action-gadget) 
-    ())
+    (value-gadget action-gadget) 
+    ((editable-p :initarg :editable-p :accessor
+		 gadget-editable-p))
+  (:default-initargs :editable-p t))
 
 (defclass text-editor (text-field) 
     ((ncolumns :initarg :ncolumns
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 160fcdae69284dff5834405d3b5a9b4485e02175..d31633872851cad3bc35a7e652fce003986f936a 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.43 92/11/06 19:04:13 cer Exp $
+;; $fiHeader: test-suite.lisp,v 1.44 92/11/09 19:55:44 cer Exp $
 
 (in-package :clim-user)
 
@@ -684,6 +684,23 @@ people, shall not perish from the earth.
 	(draw-text* stream "Dont be silly in the City." x 200
 		    :towards-x x :towards-y 0)))))
 
+(define-test (pixmap-test graphics) (stream)
+  "Test pixmap code"
+  (with-sheet-medium (medium stream)
+    (let ((pixmap (with-output-to-pixmap (ps stream :width 100 :height 100)
+		    (draw-rectangle* ps 0 0 100 100 :ink +red+)
+		    (surrounding-output-with-border (ps)
+			(draw-text* ps "hello" 10 50)))))
+      (dotimes (i 5)
+	(sleep 0.25)
+	(copy-from-pixmap pixmap 0 0 100 100 medium (* i 100) (* i 100))))
+    (dotimes (j 5)
+      (let ((pixmap (copy-to-pixmap medium (* j 100) (* j 100) 100 100)))
+	(dotimes (i 5)
+	  (unless (= i j)
+	    (sleep 0.25)
+	    (copy-from-pixmap pixmap 0 0 100 100 medium (* j 100) (* i 100))))))))
+
 (defparameter *named-colors*
  '(+white+ +black+ +red+ +green+ +blue+ +yellow+ +cyan+ +magenta+
    "snow" "ghost-white" "white-smoke" "gainsboro" "floral-white" "old-lace"
@@ -1791,9 +1808,82 @@ Luke Luck licks the lakes Luke's duck likes."))
 			      :line-cap-shape :round))))))))))
 
 (define-test (gadgets-dialog menus-and-dialogs) (stream)
-  "An own-window ACCEPTING-VALUES dialog that has graphics inside of it."
+  "An own-window ACCEPTING-VALUES dialog that has lots of gadgets inside of it."
   (gadgets-dialog-internal stream nil))
 
+(define-test (ozone-dialog menus-and-dialogs) (stream)
+  "Test of gadgets out in hyper space"
+  (let ((x "hello"))
+    (accepting-values (stream :own-window nil :label "Gadgets dialog")
+	(stream-set-cursor-position stream 100000 0)
+      (setq x (accept 'string :view +text-field-view+ 
+		      :stream stream
+		      :default x))
+      (terpri stream))))
+
+
+(define-test (readonly-gadget-dialog menus-and-dialogs) (stream)
+  " Create a bunch of readonly gadgets"
+  (accepting-values (stream :own-window nil :label "Gadgets dialog"
+			    :align-prompts t)
+      (macrolet ((do-presents (view &rest p)
+		   `(progn
+		      ,@(mapcar #'(lambda (x)
+				    `(progn
+				       (present ',(car x) ',(cadr x)
+						,@(and view `(:view ,view))
+						:prompt (format nil "~A,~A"
+								',(cadr x)
+								(if ,view (type-of ,view) :default))
+						:stream stream)
+				       (terpri stream)))
+				p))))
+	(do-presents
+	    nil
+	  (5.0 real)
+	  ("xxx" string)
+	  (#P"/tmp/fooo" pathname)
+	  (:a (member :a :b))
+	  ((:a :b) (subset :a :b))
+	  (( 3 4) (sequence integer))
+	  ;; sequence-enumerated
+	  (t boolean))
+	
+	(do-presents
+	    +text-field-view+
+	  (5.0 real)
+	  ("xxx" string)
+	  (#P"/tmp/fooo" pathname)
+	  (:a (member :a :b))
+	  ((:a :b) (subset :a :b))
+	  (( 3 4) (sequence integer))
+	  ;; sequence-enumerated
+	  (t boolean))
+		
+      
+	(do-presents
+	    '(text-editor-view :nlines 5 :ncolumns 30)
+	  ("      (do-presents
+	  +text-field-view+
+	  (5.0 real)
+	(xxx string)
+	(#P/tmp/fooo pathname)
+	(:a (member :a :b))
+	((:a :b) (subset :a :b))
+	(( 3 4) (sequence integer))
+	;; sequence-enumerated
+	(t boolean)) "
+	      string))
+	
+	(do-presents
+	    +slider-view+
+	  (5.0 float)
+	  (1 integer)))))
+
+
+	
+	
+
 
 (defun gadgets-dialog-internal (stream &optional own-window)
   (macrolet ((accepts (&rest accepts)
diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp
index de0d17fe8b4da7ab323faa39e67796aa3342f969..8236d62f82bfcac4df06ef0d6af4cff156c18b1d 100644
--- a/tk-silica/ol-gadgets.lisp
+++ b/tk-silica/ol-gadgets.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-gadgets.lisp,v 1.29 92/10/04 14:16:48 cer Exp $
+;; $fiHeader: ol-gadgets.lisp,v 1.30 92/10/28 11:33:15 cer Exp $
 
 
 (in-package :xm-silica)
@@ -51,15 +51,14 @@
 ;;;;;;;;;;;;;;;;;;;;
 
 (defclass openlook-scroll-bar (scroll-bar
+			       xt-oriented-gadget
 			       xt-leaf-pane)
 	  ())
 
 (defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port)
 						     (parent t)
 						     (sheet openlook-scroll-bar))
-  (with-accessors ((orientation gadget-orientation)) sheet
-		  (values 'tk::scrollbar
-			  (list :orientation orientation))))
+  (values 'tk::scrollbar nil))
 
 (defmethod (setf scroll-bar-size) (nv (sb openlook-scroll-bar))
   ;; (tk::set-values (sheet-direct-mirror sb) :slider-size nv)
@@ -451,11 +450,15 @@
 (defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port)
 						     (parent t)
 						     (sheet openlook-text-field))
-  (with-accessors ((value gadget-value)) sheet
-    (values 'tk::text-field
-	    (append
-	     `(:chars-visible ,(if (zerop (length value)) 30 (length value)))
-	     (and value `(:string ,value))))))
+  (with-accessors ((value gadget-value)
+		   (editable gadget-editable-p)) sheet
+    (if editable
+	(values 'tk::text-field
+		(append
+		 `(:chars-visible ,(if (zerop (length value)) 30 (length value)))
+		 (and value `(:string ,value))))
+      (values 'tk::static-text
+	      `(:string ,value)))))
 
 (defun openlook-text-field-edit-widget (tf &optional (mirror (sheet-direct-mirror tf)))
   (tk::get-values mirror :text-edit-widget))
@@ -599,31 +602,6 @@
     (with-no-value-changed-callbacks
 	(tk::set-values (sheet-mirror gadget) :set nv))))
 
-
-
-
-;;; 
-
-;; Openlook-orriented-gadget
-
-(defclass openlook-oriented-gadget () ())
-
-(defmethod find-widget-class-and-initargs-for-sheet :around ((port openlook-port)
-							     (parent t)
-							     (sheet openlook-oriented-gadget))
-  (multiple-value-bind
-      (class initargs)
-      (call-next-method)
-    (with-accessors ((orientation gadget-orientation)) sheet
-      (unless (getf initargs :orientation)
-	(setf (getf initargs :orientation) orientation)))
-    (values class initargs)))
-
-(defmethod (setf gadget-orientation) :after (nv (gadget openlook-oriented-gadget))
-  (when (sheet-direct-mirror gadget)
-    (tk::set-values (sheet-direct-mirror gadget) :orientation nv)))
-
-
 ;;
 
 (defclass openlook-radio-box (openlook-geometry-manager 
@@ -737,7 +715,7 @@
 
 
 (defclass openlook-slider (#+ignore openlook-range-pane
-			   #+ignore openlook-oriented-gadget
+			   xt-oriented-gadget
 			   xt-leaf-pane
 			   slider)
 	  ())
@@ -748,14 +726,13 @@
   (with-accessors ((label gadget-label)
 		   (show-value-p gadget-show-value-p)
 		   (value gadget-value)
-		   (orientation gadget-orientation)) sheet
+		   (editable gadget-editable-p)) sheet
     (multiple-value-bind
 	(smin smax) (gadget-range* sheet)
       (let ((mmin 0) 
 	    (mmax 100))
-	(values 'tk::slider
+	(values (if editablep 'tk::slider 'tk::gauge)
 		(append
-		 (list :orientation orientation)
 		 #+dunno
 		 (and label (list :title-string label))
 		 (list :slider-min mmin
@@ -871,9 +848,11 @@
 						      openlook-text-editor))
   (with-accessors ((value gadget-value)
 		   (ncolumns gadget-columns)
-		   (nlines gadget-lines)) sheet
+		   (nlines gadget-lines)
+		   (editable gadget-editable-p)) sheet
     (values 'tk::text-edit
 	    (append
+	     `(and (not editable) `(:edit-type :text-read))
 	     (and ncolumns (list :chars-visible ncolumns))
 	     (and nlines (list :lines-visible nlines))
 	     (and value `(:source ,value))))))
diff --git a/tk-silica/ol-silica.lisp b/tk-silica/ol-silica.lisp
index df54ab8fb3e7254e5e88c2f39922f8f086ad56cb..cd99952c5393ea96202c1cd44acc3f6e75d8a9c8 100644
--- a/tk-silica/ol-silica.lisp
+++ b/tk-silica/ol-silica.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-silica.lisp,v 1.14 92/09/22 19:38:05 cer Exp $
+;; $fiHeader: ol-silica.lisp,v 1.15 92/10/02 15:20:56 cer Exp $
 
 (in-package :xm-silica)
 
@@ -53,15 +53,17 @@
 	(let ((window (tk::widget-window mirror)))
 	  (with-port-event-lock (port)
 	    (excl:without-interrupts
-	      (tk:with-server-grabbed ((port-display port))
-		(when (eq (tk::window-map-state window) :viewable)
-		  ;;--- There could very well be a race condition involving
-		  ;;--- a couple of processes.  Another process could have made
-		  ;;--- this window go away at this point
-		  (tk::ol_set_input_focus 
-		   mirror
-		   2			; RevertToParent
-		   0))))))))))
+	      (let ((display (port-display port)))
+		(tk:with-server-grabbed (display)
+		  (when (eq (tk::window-map-state window) :viewable)
+		    ;;--- There could very well be a race condition involving
+		    ;;--- a couple of processes.  Another process could have made
+		    ;;--- this window go away at this point
+		    (tk::ol_set_input_focus 
+		     mirror
+		     2			; RevertToParent
+		     ;;-- This is not exact but it might work better.
+		     (xt::xt-last-timestamp-processed display))))))))))))
 
 (defmethod change-widget-geometry ((parent tk::draw-area) child
 				   &rest args
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index f3832ff0898c20285ec8aeeeee59e9fcf3f8f5be..81d8e365405638abf9544cf8599c3e8b94023855 100644
--- a/tk-silica/xm-gadgets.lisp
+++ b/tk-silica/xm-gadgets.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-gadgets.lisp,v 1.55 92/11/09 10:56:09 cer Exp $
+;; $fiHeader: xm-gadgets.lisp,v 1.56 92/11/09 19:56:00 cer Exp $
 
 (in-package :xm-silica)
 
@@ -133,25 +133,6 @@
                                  (:center :center)
                                  (:right :end)))))
 
-;; Motif-orriented-gadget
-
-(defclass motif-oriented-gadget () ())
-
-(defmethod find-widget-class-and-initargs-for-sheet :around ((port motif-port)
-                                                             (parent t)
-                                                             (sheet motif-oriented-gadget))
-  (multiple-value-bind
-      (class initargs)
-      (call-next-method)
-    (with-accessors ((orientation gadget-orientation)) sheet
-      (unless (getf initargs :orientation)
-        (setf (getf initargs :orientation) orientation)))
-    (values class initargs)))
-
-(defmethod (setf gadget-orientation) :after (nv (gadget motif-oriented-gadget))
-  (when (sheet-direct-mirror gadget)
-    (tk::set-values (sheet-direct-mirror gadget) :orientation nv)))
-
 ;;; Motif widgets that support the activate callback
 
 (defclass motif-action-pane () ())
@@ -258,7 +239,7 @@
 
 ;;; 
 
-(defclass motif-separator (motif-oriented-gadget
+(defclass motif-separator (xt-oriented-gadget
                            xt-leaf-pane
                            silica::separator)
           ())
@@ -270,8 +251,19 @@
 
 ;;; Slider
 
+(defclass motif-oriented-sliding-gadget (xt-oriented-gadget)
+	  ())
+
+(defmethod set-widget-orientation ((gadget motif-oriented-sliding-gadget) nv)
+  (tk::set-values (sheet-direct-mirror gadget) 
+		  :processing-direction 
+		  (case nv
+		    (:vertical :max-on-top)
+		    (:horizontal :max-on-right))
+		  :orientation nv))
+
 (defclass motif-slider (motif-range-pane
-                        motif-oriented-gadget
+                        motif-oriented-sliding-gadget
                         xt-leaf-pane
                         slider)
           ())
@@ -294,7 +286,7 @@
             (mmax 100)
             (decimal-points 0)
             (decimal-places (slider-decimal-places sheet)))
-        (cond ((and (or (null decimal-places) (zerop decimal-places))
+        (cond ((and (zerop decimal-places)
                     (typep smin '(signed-byte 32))
                     (typep smax '(signed-byte 32)))
                (setq mmin smin mmax smax decimal-points 0))
@@ -353,7 +345,7 @@
 
 
 (defclass motif-scroll-bar (scroll-bar
-                            motif-oriented-gadget
+                            motif-oriented-sliding-gadget
                             xt-leaf-pane)
           ())
 
@@ -513,9 +505,12 @@
 (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
                                                      (parent t)
                                                      (sheet motif-text-field))
-  (with-accessors ((value gadget-value)) sheet
+  (with-accessors ((editable gadget-editable-p)
+		   (value gadget-value)) sheet
     (values 'tk::xm-text-field 
             (append
+	     (and (not editable) '(:cursor-position-visible nil))
+	     `(:editable ,editable)
              (and value `(:value ,value))))))
 
 ;;; 
@@ -537,6 +532,7 @@
                    (nlines gadget-lines)) sheet
     (values 'tk::xm-text
             (append
+	     (and (not editable) '(:cursor-position-visible nil))
              (list :edit-mode :multi-line)
              (list :editable editable)
              (and ncolumns (list :columns ncolumns))
@@ -682,7 +678,7 @@
 
 (defclass motif-radio-box (motif-geometry-manager
                            mirrored-sheet-mixin
-                           motif-oriented-gadget
+                           xt-oriented-gadget
                            sheet-multiple-child-mixin
                            sheet-permanently-enabled-mixin
                            radio-box
@@ -701,7 +697,7 @@
 
 (defclass motif-check-box (motif-geometry-manager
                            mirrored-sheet-mixin
-                           motif-oriented-gadget
+                           xt-oriented-gadget
                            sheet-multiple-child-mixin
                            sheet-permanently-enabled-mixin
                            check-box
diff --git a/tk-silica/xt-gadgets.lisp b/tk-silica/xt-gadgets.lisp
index 32168a7c37e777d0546ce2100ed977be14b1524d..6dd32bbb510db931812e0a163ff60a495fad0889 100644
--- a/tk-silica/xt-gadgets.lisp
+++ b/tk-silica/xt-gadgets.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-gadgets.lisp,v 1.23 92/10/02 15:21:06 cer Exp $
+;; $fiHeader: xt-gadgets.lisp,v 1.24 92/10/28 13:17:44 cer Exp $
 
 (in-package :xm-silica)
 
@@ -190,3 +190,26 @@
 		   (clim-internals::keyboard-event-matches-gesture-name-p event gesture port))
 	       (top-level-sheet-accelerator-gestures (frame-top-level-sheet frame))))))
 
+
+;; Xt-orriented-gadget
+
+(defclass xt-oriented-gadget () ())
+
+(defmethod find-widget-class-and-initargs-for-sheet :around ((port xt-port)
+                                                             (parent t)
+                                                             (sheet xt-oriented-gadget))
+  (multiple-value-bind
+      (class initargs)
+      (call-next-method)
+    (with-accessors ((orientation gadget-orientation)) sheet
+      (unless (getf initargs :orientation)
+        (setf (getf initargs :orientation) orientation)))
+    (values class initargs)))
+
+(defmethod (setf gadget-orientation) :after (nv (gadget xt-oriented-gadget))
+  (when (sheet-direct-mirror gadget)
+    (set-widget-orientation gadget nv)))
+
+(defmethod set-widget-orientation ((gadget xt-oriented-gadget) nv)
+  (tk::set-values (sheet-direct-mirror gadget) :orientation nv))
+
diff --git a/tk-silica/xt-pixmaps.lisp b/tk-silica/xt-pixmaps.lisp
index c7ce3e1b0ba33726307b4c51401715d71ad0e48b..a6cb1c1f3d941b52da42a9d38f649266d6f08055 100644
--- a/tk-silica/xt-pixmaps.lisp
+++ b/tk-silica/xt-pixmaps.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-pixmaps.lisp,v 1.10 92/09/08 15:19:21 cer Exp $
+;; $fiHeader: xt-pixmaps.lisp,v 1.11 92/10/02 15:21:10 cer Exp $
 
 
 (in-package :xm-silica)
@@ -115,6 +115,32 @@
 		     (unless event
 		       (return))))))))))))
 
+
+(defmethod medium-copy-area 
+	   ((pixmap tk::pixmap) from-x from-y width height
+	    (to-medium xt-medium) to-x to-y)
+  (let ((transform (sheet-native-transformation (medium-sheet to-medium))))
+    (convert-to-device-coordinates transform to-x to-y)
+    (let* ((window (medium-drawable to-medium))
+	   (copy-gc (port-copy-gc (port to-medium))))
+      (tk::copy-area 
+	pixmap copy-gc from-x from-y width height
+	window to-x to-y))))
+
+
+(defmethod medium-copy-area 
+	   ((from-medium xt-medium) from-x from-y width height
+				    (pixmap tk::pixmap) to-x to-y)
+  ;;; What about the graphics exposure event problem
+  (let ((transform (sheet-native-transformation (medium-sheet from-medium))))
+    (convert-to-device-coordinates transform from-x from-y)
+    (convert-to-device-distances transform width height)
+    (let* ((window (medium-drawable from-medium))
+	   (copy-gc (port-copy-gc (port from-medium))))
+      (tk::copy-area 
+	window copy-gc from-x from-y width height 
+	pixmap to-x to-y))))
+
 ;;; I dont understand the need for these methods
 ;;; Also what is the xt-pixmap class below.
 
@@ -149,27 +175,3 @@
 	pixmap copy-gc from-x from-y width height
 	window to-x to-y))))
 
-#+ignore
-(defmethod medium-copy-area 
-	   ((from-medium xt-medium) from-x from-y width height
-	    (pixmap tk::pixmap) to-x to-y)
-  (let ((transform (sheet-native-transformation (medium-sheet from-medium))))
-    (convert-to-device-coordinates transform from-x from-y)
-    (convert-to-device-distances transform width height)
-    (let ((window (medium-drawable from-medium))
-	  (copy-gc (make-instance 'tk::gcontext :drawable window)))
-      (tk::copy-area 
-	window copy-gc from-x from-y width height 
-	pixmap to-x to-y))))
-
-#+ignore
-(defmethod medium-copy-area 
-	   ((pixmap tk::pixmap) from-x from-y width height
-	    (to-medium xt-medium) to-x to-y)
-  (let ((transform (sheet-native-transformation (medium-sheet to-medium))))
-    (convert-to-device-coordinates transform to-x to-y)
-    (let ((window (medium-drawable to-medium))
-	  (copy-gc (make-instance 'tk::gcontext :drawable window)))
-      (tk::copy-area 
-	pixmap copy-gc from-x from-y width height
-	window to-x to-y))))
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index 919e85ecaecfb305e4c6d7a67af8d47da6c1addc..9f8a67ba82a35092c4fcc9dcac3ffcac254754c2 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.55 92/11/05 17:16:01 cer Exp $
+;; $fiHeader: xt-silica.lisp,v 1.56 92/11/06 19:04:44 cer Exp $
 
 (in-package :xm-silica)
 
@@ -47,7 +47,9 @@
 (defmethod port-type ((port xt-port))
   ':xt)
 
+
 (defmethod port-copy-gc ((port xt-port))
+  ;;-- Assume 1-1 port-graft mapping?
   (with-slots (copy-gc display) port
     (or copy-gc
 	(setf copy-gc
@@ -927,6 +929,26 @@
   (apply #'tk::set-values child args))
 
 
+(defmethod change-widget-geometry :around (parent child &key x y width height)
+  ;;-- Nasty use of (widget-callback-data child) field
+  (unless (and (typep x '(signed-byte 16))
+	       (typep (+ x width) '(signed-byte 16))
+	       (typep y '(signed-byte 16))
+	       (typep (+ y height) '(signed-byte 16)))
+    (let ((window (tk::widget-window child nil)))
+      (when (and window (not (assoc 'widget-is-cached (tk::widget-callback-data child))))
+	(push (cons 'widget-is-cached t) (tk::widget-callback-data child))
+	(x11::xunmapwindow (xt::widget-display child) window)))
+    (return-from change-widget-geometry nil))
+  ;; Make sure its mapped
+  (let ((x (assoc 'widget-is-cached (tk::widget-callback-data child))))
+    (when x 
+      (setf (tk::widget-callback-data child)  (delete x (tk::widget-callback-data child)))
+      (let ((window (tk::widget-window child nil)))
+	(when window (x11::xmapwindow (xt::widget-display child) window)))))
+  ;; 
+  (call-next-method))
+
 (defmethod popup-frame-p ((frame application-frame))
   (typep frame '(or clim-internals::menu-frame clim-internals::accept-values-own-window)))
 
diff --git a/tk/ol-classes.lisp b/tk/ol-classes.lisp
index c7558796d005bcb857eeca28f68fb47103642528..06163a398b3a520fe55a3a488d1aea3f86b89fe0 100644
--- a/tk/ol-classes.lisp
+++ b/tk/ol-classes.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-classes.lisp,v 1.6 92/06/23 08:19:12 cer Exp $
+;; $fiHeader: ol-classes.lisp,v 1.7 92/08/18 17:53:40 cer Exp $
 
 (in-package :tk)
 
@@ -65,6 +65,7 @@
 				   "_flatWidgetClass"
 				   "_footerPanelWidgetClass"
 				   "_formWidgetClass"
+				   "_gaugeWidgetClass"
 				   "_helpWidgetClass"
 				   "_listPaneWidgetClass"
 				   "_magWidgetClass"
diff --git a/tk/resources.lisp b/tk/resources.lisp
index 549ade1a67157d880b108e9a7ce2adfcf4b9338e..c05d514344fe9de5c71cdd66d4fc783f090d853a 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.35 92/10/04 14:16:04 cer Exp $
+;; $fiHeader: resources.lisp,v 1.36 92/11/10 08:56:23 cer Exp $
 
 (in-package :tk)
 
@@ -630,3 +630,9 @@
   (make-instance 'font
 		 :display (widget-display parent)
 		 :foreign-address value))
+
+
+(define-enumerated-resource processing-direction (:max-on-top
+						  :max-on-bottom
+						  :max-on-left
+						  :max-on-right))
diff --git a/tk/xt-funs.lisp b/tk/xt-funs.lisp
index 111cc0590c2125aad5118fb4b48d1685fe2fb96d..ec156e914fc4441c2eaeaf3d025d690ea67c5867 100644
--- a/tk/xt-funs.lisp
+++ b/tk/xt-funs.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-funs.lisp,v 1.12 92/09/22 19:36:41 cer Exp $
+;; $fiHeader: xt-funs.lisp,v 1.13 92/10/02 15:18:02 cer Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -315,3 +315,11 @@
     :arg-checking nil
     :return-type :fixnum)
 
+
+(defforeign 'xt-last-timestamp-processed
+    :entry-point "_XtLastTimestampProcessed"
+    :call-direct t
+    :arguments '(foreign-address	; display
+		 )
+    :arg-checking nil
+    :return-type :unsigned-integer)