diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index bdb1d52889574e5e334d62c7f7bc0c1c07e87208..7bfaf9895f20d1b78969123c76f6034ffd603340 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.39 92/10/28 08:19:20 cer Exp Locker: cer $
+;; $fiHeader: accept-values.lisp,v 1.40 92/10/28 11:31:22 cer Exp $
 
 (in-package :clim-internals)
 
@@ -98,13 +98,31 @@
     (call-next-method))
   query-identifier)
 
-(defmethod stream-accept ((stream accept-values-stream) ptype
-			  &key query-identifier (prompt t) (default nil default-supplied-p)
+(defmethod stream-accept ((stream accept-values-stream) type
+			  &rest accept-args
+			  &key (prompt t) (default nil default-supplied-p)
 			       (view (stream-default-view stream)) (active-p t)
 			  &allow-other-keys)
+  (declare (dynamic-extent accept-args))
   ;;--- When ACTIVE-P is NIL, this should do some sort of "graying out"
-  (let ((query (find-or-add-query stream query-identifier ptype prompt
-				  default default-supplied-p view active-p)))
+  (let ((align-prompts (slot-value (slot-value stream 'avv-frame) 'align-prompts))
+	query-identifier query)
+    (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) type view accept-args)))
+	     (formatting-cell (stream :align-x :left)
+	       (setq query (find-or-add-query stream query-identifier type prompt
+					      default default-supplied-p view active-p)))))
+	  (t
+	   (setq query-identifier
+		 (apply #'prompt-for-accept
+			(encapsulated-stream stream) type view accept-args))
+	   (setq query (find-or-add-query stream query-identifier type prompt
+					  default default-supplied-p view active-p))))
     (values (accept-values-query-value query)
 	    (accept-values-query-type query)
 	    ;; Set this to NIL so that it appears that nothing has
@@ -188,41 +206,29 @@
        :initform nil :initarg :initially-select-query-identifier)
      (resynchronize-every-pass :initform nil :initarg :resynchronize-every-pass)
      (check-overlapping :initform t :initarg :check-overlapping)
-     (own-window :initform nil :initarg :own-window))
+     (align-prompts :initform nil :initarg :align-prompts)
+     (own-window :initform nil :initarg :own-window)
+     (own-window-properties :initform nil :initarg :own-window-properties))
   (:top-level (accept-values-top-level))
   (:command-definer t))
 
-;; Ignore extra initargs...
-(defmethod initialize-instance :after ((frame accept-values) 
-				       &key own-window
-					    x-position y-position width height
-					    right-margin bottom-margin)
-  (declare (ignore own-window
-		   x-position y-position width height
-		   right-margin bottom-margin)))
-
 ;;--- These frames should be resourced
 (define-application-frame accept-values-own-window (accept-values)
-    ((own-window :initarg :own-window)
-     (own-window-x-position :initform nil :initarg :x-position)
-     (own-window-y-position :initform nil :initarg :y-position)
-     (own-window-width :initform nil :initarg :width)
-     (own-window-height :initform nil :initarg :height)
-     (own-window-right-margin :initform nil :initarg :right-margin)
-     (own-window-bottom-margin :initform nil :initarg :bottom-margin)
-     (help-window :initform nil))
+    ((help-window :initform nil)
+     (scroll-bars :initform nil :initarg :scroll-bars))
   (:pane 
-    (with-slots (stream own-window exit-button-stream) *application-frame*
+    (with-slots (stream own-window exit-button-stream scroll-bars) *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 :off))))
-	      own-window)))
+	  (progn
+	    (setq stream (make-instance 'accept-values-stream
+			   :stream (setq own-window 
+					 (make-pane 'clim-stream-pane
+					   :initial-cursor-visibility :off
+					   :end-of-page-action :allow))))
+	    (if scroll-bars
+		(scrolling (:scroll-bars scroll-bars) own-window)
+		own-window)))
 	(outlining ()
 	  (setf exit-button-stream
 		(make-pane 'clim-stream-pane
@@ -252,17 +258,22 @@
 				      (exit-boxes 
 					(frame-manager-default-exit-boxes
 					  (frame-manager stream)))
- 				      (resize-frame nil)
+ 				      (resize-frame nil) (scroll-bars nil)
 				      (initially-select-query-identifier nil)
-				      (modify-initial-query nil)
+				      (modify-initial-query nil) align-prompts
 				      (resynchronize-every-pass nil) (check-overlapping t)
 				      label x-position y-position width height)
    (incf *accept-values-tick*)
+   (setq align-prompts (ecase align-prompts
+			 ((t :right) :right)
+			 ((:left) :left)
+			 ((nil) nil)))
    (let ((frame-manager (frame-manager stream))
 	 (*current-accept-values-tick* *accept-values-tick*)
 	 (the-own-window nil)
 	 (right-margin 10)
 	 (bottom-margin 10))
+     ;; Create the AVV, run it, and return its values
      (if own-window
 	 (let ((frame (make-application-frame 
 			(or frame-class 
@@ -274,59 +285,70 @@
 			:continuation continuation
 			:exit-boxes exit-boxes
 			:own-window the-own-window
-			:width width :height height
-			:x-position x-position
-			:y-position y-position
-			:right-margin right-margin
-			:bottom-margin bottom-margin
-			:initially-select-query-identifier 
-			  (and initially-select-query-identifier
-			       (cons initially-select-query-identifier modify-initial-query))
-			:resynchronize-every-pass resynchronize-every-pass
-			:check-overlapping check-overlapping
-			:resize-frame resize-frame)))
-	   (when command-table
-	     (setf (frame-command-table frame) command-table))
-	   (let ((*avv-calling-frame* *application-frame*))
-	     (run-frame-top-level frame)))
-       (using-resource (avv-stream accept-values-stream (or the-own-window stream))
-	 ;;--- This should resource the AVV application frame, too
-	 (let ((frame (make-application-frame (or frame-class 'accept-values)
-			:calling-frame *application-frame*
-			:stream avv-stream
-			:continuation continuation
-			:exit-boxes exit-boxes
+			:own-window-properties (list x-position y-position
+						     width height
+						     right-margin bottom-margin)
 			:initially-select-query-identifier 
 			  (and initially-select-query-identifier
 			       (cons initially-select-query-identifier modify-initial-query))
 			:resynchronize-every-pass resynchronize-every-pass
 			:check-overlapping check-overlapping
-			;; This frame won't necessarily be adopted, so make
-			;; sure that we share the sheet with the parent frame
-			;; in the case of "inlined" dialogs
-			:top-level-sheet (frame-top-level-sheet *application-frame*))))
+			:align-prompts align-prompts
+			:resize-frame resize-frame
+			:scroll-bars scroll-bars)))
 	   (when command-table
 	     (setf (frame-command-table frame) command-table))
-	   ;; Run the AVV and return its values
-	   (let ((*avv-calling-frame* *application-frame*))
-	     (run-frame-top-level frame)))))))
+	   (unwind-protect
+	       (let ((*avv-calling-frame* *application-frame*))
+		 (run-frame-top-level frame))
+	     ;; Flush it so the GC can get rid of it
+	     (disown-frame (frame-manager frame) frame)))
+	 (using-resource (avv-stream accept-values-stream (or the-own-window stream))
+	   (let ((frame (make-application-frame (or frame-class 'accept-values)
+			  :calling-frame *application-frame*
+			  :stream avv-stream
+			  :continuation continuation
+			  :exit-boxes exit-boxes
+			  :initially-select-query-identifier 
+			    (and initially-select-query-identifier
+				 (cons initially-select-query-identifier modify-initial-query))
+			  :resynchronize-every-pass resynchronize-every-pass
+			  :check-overlapping check-overlapping
+			  :align-prompts align-prompts
+			  ;; This frame won't necessarily be adopted, so make
+			  ;; sure that we share the sheet with the parent frame
+			  ;; in the case of "inlined" dialogs
+			  :top-level-sheet (frame-top-level-sheet *application-frame*))))
+	     (when command-table
+	       (setf (frame-command-table frame) command-table))
+	     (unwind-protect
+		 (let ((*avv-calling-frame* *application-frame*))
+		   (run-frame-top-level frame))
+	       ;; Since this frame isn't really adopted, we don't really want
+	       ;; to disown it since that will end up disowning the calling
+	       ;; frame.  Flush it from the frame manager manually.  Barf.
+	       (let ((framem (frame-manager frame)))
+		 (setf (frame-manager-frames framem)
+		         (delete frame (frame-manager-frames framem))
+		       (slot-value frame 'frame-manager) nil))))))))
 
 (defmethod accept-values-top-level ((frame accept-values) &rest args)
   (declare (ignore args))
-  ;; this might want to use table-formatting or equivalent
-  ;; to make sure that the rows line up properly.
-  ;; This requires formatting-table and friends to return their bodies' values properly.
   (with-slots (stream continuation resynchronize-every-pass check-overlapping
-	       selected-item initially-select-query-identifier
-	       own-window own-window-x-position own-window-y-position
-	       own-window-width own-window-height
-	       own-window-right-margin own-window-bottom-margin
-	       exit-button-stream) frame
+	       align-prompts selected-item initially-select-query-identifier
+	       own-window own-window-properties exit-button-stream) frame
     (let* ((original-view (stream-default-view stream))
 	   (return-values nil)
 	   (initial-query nil)
 	   exit-button-record
-	   avv avv-record)
+	   avv avv-record
+	   (properties own-window-properties)
+	   (own-window-x-position (pop properties))
+	   (own-window-y-position (pop properties))
+	   (own-window-width  (pop properties))
+	   (own-window-height (pop properties))
+	   (own-window-right-margin  (pop properties))
+	   (own-window-bottom-margin (pop properties)))
       (letf-globally (((stream-default-view stream) 
 		       (frame-manager-dialog-view (frame-manager frame)))
 		      ((cursor-state (stream-text-cursor stream)) nil))
@@ -334,9 +356,19 @@
 		   (setf (slot-value stream 'avv-record) avv-record)
 		   (setf (slot-value stream 'avv-frame) frame)
 		   (with-output-recording-options (stream :draw nil :record t)
-		     (setq return-values (multiple-value-list
-					   (let ((*application-frame* *avv-calling-frame*))
-					     (funcall continuation stream))))
+		     (let ((*application-frame* *avv-calling-frame*))
+		       (if align-prompts
+			   ;; Use of FORMATTING-TABLE here implies that
+			   ;; no output should be done by the user code
+			   ;; outside of calls to FORMATTING-ROW and
+			   ;; FORMATTING-CELL.  Too bad.
+			   (formatting-table (stream)
+			     (setq return-values
+				   (multiple-value-list
+				     (funcall continuation stream))))
+			   (setq return-values
+				 (multiple-value-list
+				   (funcall continuation stream)))))
 		     (unless own-window
 		       (display-exit-boxes frame stream
 					   (stream-default-view stream)))))
@@ -404,7 +436,12 @@
 			 :bottom-margin own-window-bottom-margin)))))
 	  (declare (dynamic-extent #'run-continuation #'run-avv
 				   #'size-panes-appropriately))
-	  (with-simple-restart (frame-exit "Exit from the ACCEPT-VALUES dialog")
+	  (handler-bind ((frame-exit
+			   #'(lambda (condition)
+			       (let ((exit-frame (frame-exit-frame condition)))
+				 (when (eq frame exit-frame)
+				   (return-from accept-values-top-level
+				     (values-list return-values)))))))
 	    (setq avv
 		  (updating-output (stream)
 		    (setq avv-record
@@ -432,7 +469,7 @@
 				 y own-window-y-position))
 			 (position-sheet-carefully
 			   (frame-top-level-sheet (pane-frame own-window)) x y))
-		       (window-expose own-window)
+		       (setf (window-visibility own-window) t)
 		       (with-input-focus (own-window)
 			 (when exit-button-record
 			   (replay exit-button-record exit-button-stream))
@@ -446,11 +483,10 @@
 		       (stream-ensure-cursor-visible stream)
 		       (replay avv stream)
 		       (run-avv)))
-	      (unless own-window (deactivate-all-gadgets avv-record))
 	      (unless own-window
+		(deactivate-all-gadgets avv-record)
 		(move-cursor-beyond-output-record 
-		  (encapsulating-stream-stream stream) avv))))
-	  (values-list return-values))))))
+		  (encapsulating-stream-stream stream) avv)))))))))
 
 (defmethod frame-manager-display-input-editor-error
 	   ((framem standard-frame-manager) (frame accept-values) stream error)
@@ -489,7 +525,7 @@
       (multiple-value-bind (x y) (bounding-rectangle-position own-window)
 	(position-sheet-carefully 
 	  (frame-top-level-sheet (pane-frame help-window)) x y))
-      (window-expose help-window)
+      (setf (window-visibility help-window) t)
       (clear-input help-window)
       (unwind-protect
 	  (with-input-focus (help-window)
@@ -515,9 +551,17 @@
   (setf (slot-value (slot-value stream 'avv-record) 'resynchronize) t))
 
 (defmethod accept-values-resize-window ((stream accept-values-stream))
-  (with-slots (own-window own-window-right-margin own-window-bottom-margin)
+  (with-slots (own-window own-window-properties)
 	      (slot-value stream 'avv-frame)
     (when own-window
+    (let* ((own-window-x-position (pop own-window-properties))
+	   (own-window-y-position (pop own-window-properties))
+	   (own-window-width  (pop own-window-properties))
+	   (own-window-height (pop own-window-properties))
+	   (own-window-right-margin  (pop own-window-properties))
+	   (own-window-bottom-margin (pop own-window-properties)))
+      (declare (ignore own-window-x-position own-window-y-position 
+		       own-window-width own-window-height))
       (multiple-value-bind (new-width new-height)
 	  (bounding-rectangle-size (slot-value stream 'avv-record))
 	(multiple-value-bind (width height)
@@ -525,8 +569,8 @@
 	  (when (or (> new-width width)
 		    (> new-height height))
 	    (size-frame-from-contents own-window
-	      :right-margin own-window-right-margin
-	      :bottom-margin own-window-bottom-margin)))))))
+				      :right-margin own-window-right-margin
+				      :bottom-margin own-window-bottom-margin))))))))
 
 
 (define-presentation-type accept-values-exit-box ())
@@ -738,7 +782,7 @@
 
 (define-accept-values-command (com-exit-avv :keystroke :end)
     ()
-  (invoke-restart 'frame-exit))
+  (frame-exit *application-frame*))
 
 (define-accept-values-command (com-abort-avv :keystroke :abort)
     ()
diff --git a/clim/accept.lisp b/clim/accept.lisp
index fc9eef9fb671fb53bab989c2459c04d66a5d9551..7b36f4f8dd13a3e4d3a3054cf866d283ce28c950 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.15 92/10/28 08:19:24 cer Exp Locker: cer $
+;; $fiHeader: accept.lisp,v 1.16 92/10/28 11:31:25 cer Exp $
 
 (in-package :clim-internals)
 
@@ -57,7 +57,7 @@
       ;; If the user wants a default, but provided none, go get it from the history
       (let ((history (if (typep history 'basic-history)
 			 history
-		       (presentation-type-history history))))
+		         (presentation-type-history history))))
 	(when history
 	  (let ((element (yank-from-history history)))
 	    (when element
@@ -80,20 +80,27 @@
     (null)
     (symbol (setq view (make-instance view)))
     (cons   (setq view (apply #'make-instance view))))
-  (setq view (decode-indirect-view type view (frame-manager stream) :query-identifier query-identifier))
+  (setq view (decode-indirect-view type view (frame-manager stream)
+				   :query-identifier query-identifier))
 
-  ;; Call methods to do the work
+  ;; Call STREAM-ACCEPT to do the work.  It would be nice if we could
+  ;; call PROMPT-FOR-ACCEPT to generate the real query-id here, but we
+  ;; can't because we want to be able to decide exactly how it is called
+  ;; on a case-by-case basis.  For example, within ACCEPTING-VALUES...
   (with-keywords-removed (accept-args accept-args '(:stream :view))
-    (let ((query-identifier
-	   (apply #'prompt-for-accept
-		  (or *original-stream* stream) type view accept-args)))
-      (apply #'stream-accept (or *original-stream* stream) type
-	     :view view :query-identifier query-identifier
-	     accept-args))))
+    (apply #'stream-accept (encapsulated-stream stream) type
+			   :view view :query-identifier query-identifier
+			   accept-args)))
 
-(defmethod stream-accept ((stream input-protocol-mixin) type &rest accept-args)
+(defmethod stream-accept ((stream input-protocol-mixin) type &rest accept-args
+			  &key view &allow-other-keys)
   (declare (dynamic-extent accept-args))
-  (apply #'accept-1 (or *original-stream* stream) type accept-args))
+  (let ((query-identifier
+	  (apply #'prompt-for-accept
+		 (encapsulated-stream stream) type view accept-args)))
+    (apply #'accept-1 (encapsulated-stream stream) type
+		      :query-identifier query-identifier
+		      accept-args)))
 
 (defmethod prompt-for-accept ((stream input-protocol-mixin) type (view view)
 			      &rest accept-args
@@ -373,9 +380,15 @@
     (check-type gesture character)
     (stream-unread-char stream gesture)))
 
-(defmethod stream-accept ((stream t) type &rest accept-args)
+(defmethod stream-accept ((stream t) type &rest accept-args
+			  &key view &allow-other-keys)
   (declare (dynamic-extent accept-args))
-  (apply #'accept-1 (or *original-stream* stream) type accept-args))
+  (let ((query-identifier
+	  (apply #'prompt-for-accept
+		 (encapsulated-stream stream) type view accept-args)))
+    (apply #'accept-1 (encapsulated-stream stream) type
+		      :query-identifier query-identifier
+		      accept-args)))
 
 (defmethod prompt-for-accept ((stream t) type (view view) 
 			      &key query-identifier &allow-other-keys)
diff --git a/clim/activities.lisp b/clim/activities.lisp
index af8c8aede4ee706654d06c13a25423b6138f42fb..b6b36cf11d1164c8f5fafe87a209d3e1a2462046 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.3 92/10/02 15:19:17 cer Exp Locker: cer $
+;; $fiHeader: activities.lisp,v 1.4 92/10/29 15:02:39 cer Exp $
 
 (in-package :clim-internals)
 
@@ -32,7 +32,11 @@
   (type-of activity))
 
 (defmethod run-frame-top-level :around ((activity activity) &key)
-  (with-simple-restart (activity-exit "Exit activity ~A" (frame-pretty-name activity))
+  (handler-bind ((frame-exit
+		   #'(lambda (condition)
+		       (let ((exit-frame (frame-exit-frame condition)))
+			 (when (eq activity exit-frame)
+			   (return-from run-frame-top-level nil))))))
     (loop
       (with-simple-restart (nil "~A top level" (frame-pretty-name activity))
 	(loop
@@ -54,8 +58,8 @@
 	  (default-frame-top-level activity))
       (setq top-level-process nil))))
 
-(defmethod activity-exit ((activity activity))
-  (invoke-restart 'activity-exit))
+(defmethod frame-exit ((activity activity))
+  (signal 'frame-exit :frame activity))
 
 (defvar *activity* nil)
 
@@ -95,7 +99,7 @@
 	      (setf (activity-active-frame activity)
 		    (first (frame-manager-frames activity))))
 	    (unless (activity-active-frame activity)
-	      (activity-exit activity))
+	      (frame-exit activity))
 	    (let* ((frame (activity-active-frame activity))
 		   (*application-frame* frame)
 		   (top-level (frame-top-level frame)))
@@ -108,6 +112,7 @@
 			(if (atom top-level)
 			    (funcall top-level frame)
 			    (apply (first top-level) frame (rest top-level))))
+		      ;;--- Well, what *are* we supposed to do here?
 		      (break "do something")))
 		(setf (slot-value frame 'top-level-process) nil)))))))))
 
@@ -125,7 +130,7 @@
     ((activity :initform nil :accessor frame-activity :initarg :activity)))
 
 (defmethod initialize-instance :after ((frame activity-frame) &key activity)
-  (assert activity () "An activity frame requires an activity"))
+  (assert activity () "The activity frame ~S requires an activity" frame))
 
 ;; Starts an application frame and registers it in the activity
 (defmethod start-application-frame ((activity activity) frame-name &rest frame-options)
@@ -150,7 +155,7 @@
   (when (eq frame (activity-active-frame activity))
     (if (frame-manager-frames activity)
 	(setf (activity-active-frame activity) nil)
-	(activity-exit activity)))
+	(frame-exit activity)))
   (throw 'window-resynchronize :window-resynchronize))
 
 ;; Starts the initial application, when the activity is started up.
diff --git a/clim/basic-translators.lisp b/clim/basic-translators.lisp
index 131b127226795719f43d18c1823ff03fc8fdd061..2680d4bf129943637fa894de3934a6fcc9624046 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.8 92/08/19 10:23:53 cer Exp Locker: cer $
+;; $fiHeader: basic-translators.lisp,v 1.9 92/10/01 08:51:17 cer Exp $
 
 (in-package :clim-internals)
 
@@ -180,8 +180,7 @@
 			   (formatting-cell (stream)
 			     (print-possibility possibility stream)))))))
 	    (declare (dynamic-extent #'print-possibility #'menu-choose-body))
-	    (with-menu (menu window)
-	      (setf (window-label menu) "Menu of completions")
+	    (with-menu (menu window :label "Menu of completions")
 	      (with-end-of-line-action (menu :allow)
 		(let ((object
 			(menu-choose-from-drawer menu type #'menu-choose-body)))
diff --git a/clim/clim-defs.lisp b/clim/clim-defs.lisp
index efed771c6e6802944508f7f0ff55cb90c018c033..b941ba6f078d6146ce0ff7f223a35a05ac0b12b1 100644
--- a/clim/clim-defs.lisp
+++ b/clim/clim-defs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clim-defs.lisp,v 1.14 92/09/08 15:17:27 cer Exp $
+;; $fiHeader: clim-defs.lisp,v 1.15 92/09/24 09:38:28 cer Exp $
 
 (in-package :clim-internals)
 
@@ -91,10 +91,10 @@
 	   `(,constructor ,@initargs))
 	  (t `(construct-output-record-1 ,type ,@initargs)))))
 
-(defmacro define-output-record-constructor (record-type arglist &rest initialization-arguments)
+(defmacro define-output-record-constructor (record-type arglist &body initargs)
   (let ((constructor-name (fintern "~A-~A" record-type 'constructor)))
     `(progn
-       (define-constructor ,constructor-name ,record-type ,arglist ,@initialization-arguments)
+       (define-constructor ,constructor-name ,record-type ,arglist ,@initargs)
        (setf (gethash ',record-type *output-record-constructor-cache*)
 	     ',constructor-name))))
 )	;eval-when
@@ -272,12 +272,13 @@
 
 ;;; From MENUS.LISP
 ;;; For now, MENU-CHOOSE requires that you pass in a parent.
-(defmacro with-menu ((menu &optional (associated-window nil aw-p)) &body body)
+(defmacro with-menu ((menu &optional (associated-window nil aw-p) &key label) &body body)
   (let ((window '#:associated-window))
     `(let ((,window ,(if aw-p
 			 associated-window
 			 `(frame-top-level-sheet *application-frame*))))	;once-only
-       (using-resource (,menu menu (window-top-level-window ,window) (window-root ,window))
+       (using-resource (,menu menu (window-top-level-window ,window) (window-root ,window)
+			:label ,label)
 	 (letf-globally (((stream-default-view ,menu) +textual-menu-view+))
 	   ,@body)))))
 
@@ -285,10 +286,10 @@
 (defmacro accepting-values ((&optional stream &rest args) &body body)
   (declare (arglist (&optional stream
 		     &key frame-class command-table own-window 
-			  exit-boxes resize-frame
+			  exit-boxes resize-frame align-prompts
 			  initially-select-query-identifier modify-initial-query
 			  resynchronize-every-pass (check-overlapping t)
-			  label x-position y-position width height)
+			  label x-position y-position width height (scroll-bars nil))
 		    &body body))
   #+Genera (declare (zwei:indentation 0 3 1 1))
   (default-input-stream stream accepting-values)
diff --git a/clim/command-processor.lisp b/clim/command-processor.lisp
index c85da37a02143473ac86055b62be7edec7e5ea22..28988e5f863c2200f67e8b6127065ed52baa96bc 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.16 92/09/30 18:03:38 cer Exp $
+;; $fiHeader: command-processor.lisp,v 1.17 92/10/28 11:31:26 cer Exp $
 
 (in-package :clim-internals)
 
@@ -310,9 +310,12 @@
 						:end last-supplied :from-end t)))
 	 (command-type `(command :command-table ,command-table))
 	 (for-context-type (least-specific-matching-context-type command-type)))
-    (cond ((or unsupplied-before-that for-accelerator)
+    (cond ((or unsupplied-before-that for-accelerator
+	       (null (command-line-name-for-command 
+		       (command-name partial-command) command-table :errorp nil)))
 	   ;; If the unsupplied argument is not the last argument in the
 	   ;; command line, we go through the ACCEPTING-VALUES command parser.
+	   ;; Ditto, if there is no command-line name for the command.
 	   (let ((command
 		   (with-input-editor-typeout (stream)
 		     (accept-values-command-parser
diff --git a/clim/command.lisp b/clim/command.lisp
index a48df96558b9b5ec89b56669868eb10ea2aa1457..da87bbd70baeb1c30b6a73ff729849c8ca983b9b 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.16 92/09/08 15:17:31 cer Exp $
+;; $fiHeader: command.lisp,v 1.17 92/09/24 09:38:32 cer Exp $
 
 (in-package :clim-internals)
 
@@ -575,7 +575,7 @@
 					n-rows n-columns
 					x-spacing y-spacing 
 					(cell-align-x ':left) (cell-align-y ':top)
-					(initial-spacing t) move-cursor)
+					(initial-spacing t) (row-wise nil) move-cursor)
   (unless (or max-width max-height)
     (multiple-value-bind (width height)
 	(bounding-rectangle-size (sheet-region stream))
@@ -589,7 +589,7 @@
 				      :n-rows n-rows :n-columns n-columns
 				      :x-spacing x-spacing :y-spacing y-spacing
 				      :initial-spacing initial-spacing
-				      :move-cursor move-cursor)
+				      :row-wise row-wise :move-cursor move-cursor)
 	  (dovector (element menu)
 	    (cond ((eq (command-menu-item-type (third element)) :divider)
 		   (typecase (first element)
@@ -623,15 +623,14 @@
 (defun menu-execute-command-from-command-table
        (command-table
 	&key (associated-window (frame-top-level-sheet *application-frame*))
-	     (default-style *command-table-menu-text-style*) label
+	     (text-style *command-table-menu-text-style*) label
 	     cache (unique-id command-table) (id-test #'eql) cache-value (cache-test #'eql))
   (setq command-table (find-command-table command-table))
   (unless cache-value
     (setq cache-value (slot-value command-table 'menu-tick)))
   (let ((menu-items (slot-value command-table 'menu)))
-    (with-menu (menu associated-window)
-      (setf (window-label menu) label)
-      (with-text-style (menu default-style)
+    (with-menu (menu associated-window :label label)
+      (with-text-style (menu text-style)
 	(flet ((menu-choose-body (stream type)
 		 (declare (ignore type))
 		 (menu-choose-command-drawer stream menu-items nil)))
@@ -647,15 +646,14 @@
 (defun menu-choose-command-from-command-table
        (command-table
 	&key (associated-window (frame-top-level-sheet *application-frame*))
-	     (default-style *command-table-menu-text-style*) label
+	     (text-style *command-table-menu-text-style*) label
 	     cache (unique-id command-table) (id-test #'eql) cache-value (cache-test #'eql))
   (setq command-table (find-command-table command-table))
   (unless cache-value
     (setq cache-value (slot-value command-table 'menu-tick)))
   (let ((menu-items (slot-value command-table 'menu)))
-    (with-menu (menu associated-window)
-      (setf (window-label menu) label)
-      (with-text-style (menu default-style)
+    (with-menu (menu associated-window :label label)
+      (with-text-style (menu text-style)
 	(flet ((menu-choose-body (stream type)
 		 (menu-choose-command-drawer stream menu-items type)))
 	  (declare (dynamic-extent #'menu-choose-body))
diff --git a/clim/db-menu.lisp b/clim/db-menu.lisp
index 8950a3870419f06048dbd1828859f540c9e26a6b..f0342dac22f1f27048fc800bbd96b514e76aac57 100644
--- a/clim/db-menu.lisp
+++ b/clim/db-menu.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-menu.lisp,v 1.2 92/09/08 15:17:38 cer Exp $
+;; $fiHeader: db-menu.lisp,v 1.3 92/09/24 09:38:38 cer Exp $
 
 "Copyright (c) 1992 by Symbolics, Inc.  All rights reserved."
 
@@ -274,8 +274,7 @@
 
 ;;; Menu bars
 
-(defclass menu-bar-pane 
-	  (menu-bar)
+(defclass menu-bar-pane (menu-bar)
     ())
 
 ;;--- What about when the command menu tick changes?
diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp
index 3f166ae7241082c657233983a39d3ad5f7b0b396..495bdcf96d09f8a075152682e0fcba77b4239a59 100644
--- a/clim/db-stream.lisp
+++ b/clim/db-stream.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-stream.lisp,v 1.33 92/10/02 15:19:19 cer Exp $
+;; $fiHeader: db-stream.lisp,v 1.34 92/10/28 11:31:30 cer Exp $
 
 (in-package :clim-internals)
 
@@ -339,8 +339,9 @@
 		       `(make-pane 'label-pane 
 			  :label ,label
 			  :max-width +fill+)
-		       `(apply #'make-pane 'label-pane 
-			       :max-width +fill+ ,label))))
+		       `(make-pane 'label-pane 
+			  :label ,(first label)
+			  :max-width +fill+ ,@(rest label)))))
 	(ecase label-alignment
 	  (:bottom
 	    (setq pane `(vertically () ,pane ,label)))
@@ -360,6 +361,9 @@
 
 ;;; "Window protocol"
 
+(defun-inline window-stream-p (x)
+  (typep x 'clim-stream-sheet))
+
 (defmethod window-clear ((stream clim-stream-sheet))
   (let ((medium (sheet-medium stream)))
     (letf-globally (((medium-transformation medium) +identity-transformation+))
@@ -434,6 +438,33 @@
 (defmethod* (setf window-viewport-position) (x y (stream clim-stream-sheet))
   (window-set-viewport-position stream x y))
 
+(defmethod window-inside-edges ((stream clim-stream-sheet))
+  (bounding-rectangle* (sheet-region (or (pane-viewport stream) stream))))
+
+(defun window-inside-left (stream)
+  (multiple-value-bind (left top right bottom)
+      (window-inside-edges stream)
+    (declare (ignore top right bottom))
+    left))
+
+(defun window-inside-top (stream)
+  (multiple-value-bind (left top right bottom)
+      (window-inside-edges stream)
+    (declare (ignore left right bottom))
+    top))
+
+(defun window-inside-right (stream)
+  (multiple-value-bind (left top right bottom)
+      (window-inside-edges stream)
+    (declare (ignore left top bottom))
+    right))
+
+(defun window-inside-bottom (stream)
+  (multiple-value-bind (left top right bottom)
+      (window-inside-edges stream)
+    (declare (ignore left top right))
+    bottom))
+
 (defmethod window-inside-size ((stream clim-stream-sheet))
   (bounding-rectangle-size (window-viewport stream)))
 
@@ -446,15 +477,28 @@
 (defmethod window-inside-height ((stream clim-stream-sheet))
   (bounding-rectangle-width (window-viewport stream)))
 
+(defmethod window-margins ((stream clim-stream-sheet))
+  (values (coordinate 0) (coordinate 0)
+	  (coordinate 0) (coordinate 0)))
+
 (defun-inline window-parent (window)
   (sheet-parent window))
 
+(defun-inline window-children (window)
+  (sheet-children window))
+
 (defun window-root (window)
   (graft window))
 
 (defun-inline window-top-level-window (window)
   (sheet-top-level-sheet window))
 
+(defmethod window-stack-on-bottom ((stream clim-stream-sheet))
+  (bury-sheet (window-top-level-window stream)))
+
+(defmethod window-stack-on-top ((stream clim-stream-sheet))
+  (raise-sheet (window-top-level-window stream)))
+
 (defun beep (&optional (stream *standard-output*))
   (typecase stream
     (sheet
diff --git a/clim/db-text.lisp b/clim/db-text.lisp
index b28d063a18d8aaf644b7507ee4d8fea335c548fe..826c4ad67248268bb5805a284d67116cebaaf3ba 100644
--- a/clim/db-text.lisp
+++ b/clim/db-text.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-text.lisp,v 1.3 92/10/02 15:19:21 cer Exp $
+;; $fiHeader: db-text.lisp,v 1.4 92/10/28 11:31:32 cer Exp $
 
 "Copyright (c) 1992 by Symbolics, Inc.  All rights reserved."
 
@@ -20,7 +20,7 @@
 	  (height (process-spacing-arg stream height 'pop-up-text-editor :height)))
       (window-set-inside-size stream width height))
     (setf (stream-text-margin stream) (bounding-rectangle-width (window-viewport stream)))
-    (window-expose stream)
+    (setf (window-visibility stream) t)
     ;; Now edit the text
     (unwind-protect
 	(do-text-editing stream 
diff --git a/clim/drag-and-drop.lisp b/clim/drag-and-drop.lisp
index 647bc5749e35974e32a17e6c5f09fb626cd4f2b2..42aeebeb96fdb48042fe559aa8683738ec5e0a11 100644
--- a/clim/drag-and-drop.lisp
+++ b/clim/drag-and-drop.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: drag-and-drop.lisp,v 1.4 92/07/08 16:30:06 cer Exp Locker: cer $
+;; $fiHeader: drag-and-drop.lisp,v 1.5 92/11/05 17:15:35 cer Exp $
 
 (in-package :clim-internals)
 
@@ -108,13 +108,17 @@
 		 ,@body)
 	      function-name))))
 
+(defparameter *drag-and-drop-finish-on-release* nil)
+
 ;; All the drag-and-drop translators that satisfy the current from-type,
 ;; to-type, and gesture will get here.  However, the translator now being
 ;; run is not necessarily the right one.  What we do here is to track the 
 ;; pointer until the destination presentation has been reached, choose the
 ;; correct translator and run it.
 (defun invoke-drag-and-drop-translator (object presentation context-type
-					frame event window x y)
+					frame event window x y
+					&optional (finish-on-release
+						    *drag-and-drop-finish-on-release*))
   (let* ((command-table (frame-command-table frame))
 	 (translators
 	   (let ((all-translators
@@ -141,7 +145,9 @@
 	   (and translators (presentation-translator-highlighting (first translators))))
 	 (initial-x x)
 	 (initial-y y)
-	 last-x last-y
+	 (last-x nil)
+	 (last-y nil)
+	 (last-window nil)
 	 (from-presentation presentation)
 	 ;; The presentation we finally landed on, and the event used
 	 (destination nil)
@@ -154,9 +160,9 @@
     (unhighlight-highlighted-presentation window)
     (when (null translators)
       (return-from invoke-drag-and-drop-translator nil))
-    (flet ((find-translator (destination)
+    (flet ((find-translator (destination-presentation window x y)
 	     (let* ((translator
-		      (find (presentation-type destination) translators
+		      (find (presentation-type destination-presentation) translators
 			    :key #'presentation-translator-destination-type
 			    :test #'presentation-subtypep))
 		    (tester
@@ -165,41 +171,68 @@
 			 (funcall tester
 				  object presentation context-type
 				  frame event window x y
-				  (presentation-object destination) destination))
+				  (presentation-object destination-presentation)
+				  destination-presentation))
 		 translator))))
       (declare (dynamic-extent #'find-translator))
-      (macrolet ((feedback (x y state)
-		   `(funcall feedback frame from-presentation window 
+      (macrolet ((feedback (window x y state)
+		   `(funcall feedback frame from-presentation ,window 
 				      initial-x initial-y ,x ,y ,state))
-		 (highlight (presentation state)
+		 (highlight (presentation window state)
 		   `(when ,presentation
-		      (funcall highlighting frame ,presentation window 
-					    ,state))))
+		      (funcall highlighting frame ,presentation ,window ,state))))
 	(block drag-presentation
 	  (tracking-pointer (window :context-type `((or ,@destination-types))
 				    :multiple-window t :highlight nil)
 	    (:presentation-button-press (presentation event)
-	     (highlight destination :unhighlight)
-	     (setq destination presentation
-		   destination-event event)
-	     (return-from drag-presentation))
+	     (unless finish-on-release
+	       (highlight destination last-window :unhighlight)
+	       (setq destination presentation
+		     destination-event event
+		     last-window (event-sheet event)
+		     last-x (pointer-event-x event)
+		     last-y (pointer-event-y event))
+	       (return-from drag-presentation)))
 	    (:pointer-button-press (event)
-	     (highlight destination :unhighlight)
-	     (setq destination nil
-		   destination-event event)
-	     (return-from drag-presentation))
+	     (unless finish-on-release
+	       (highlight destination last-window :unhighlight)
+	       (setq destination nil
+		     destination-event event
+		     last-window (event-sheet event)
+		     last-x (pointer-event-x event)
+		     last-y (pointer-event-y event))
+	       (return-from drag-presentation)))
+	    (:presentation-button-release (presentation event)
+	     (when finish-on-release
+	       (highlight destination last-window :unhighlight)
+	       (setq destination presentation
+		     destination-event event
+		     last-window (event-sheet event)
+		     last-x (pointer-event-x event)
+		     last-y (pointer-event-y event))
+	       (return-from drag-presentation)))
+	    (:pointer-button-release (event)
+	     (when finish-on-release
+	       (highlight destination last-window :unhighlight)
+	       (setq destination nil
+		     destination-event event
+		     last-window (event-sheet event)
+		     last-x (pointer-event-x event)
+		     last-y (pointer-event-y event))
+	       (return-from drag-presentation)))
 	    (:presentation (presentation window x y)
 	     (when last-x
-	       (feedback last-x last-y :unhighlight))
+	       (feedback last-window last-x last-y :unhighlight))
 	     (setq last-x x
-		   last-y y)
-	     (feedback x y :highlight)
+		   last-y y
+		   last-window window)
+	     (feedback window x y :highlight)
 	     (when (not (eq presentation destination))
-	       (highlight destination :unhighlight)
+	       (highlight destination last-window :unhighlight)
 	       (setq destination presentation)
-	       (highlight presentation :highlight)
+	       (highlight presentation window :highlight)
 	       #+++ignore				;--- documentation
-	       (let ((translator (find-translator destination)))
+	       (let ((translator (find-translator destination window x y)))
 		 (when translator
 		   (let ((documentation
 			   (presentation-translator-real-documentation translator)))
@@ -211,23 +244,24 @@
 				  (presentation-object destination) destination
 				  doc-stream)))))))
 	    (:pointer-motion (window x y)
-	     (highlight destination :unhighlight)
+	     (highlight destination last-window :unhighlight)
 	     (setq destination nil)
 	     (when last-x
-	       (feedback last-x last-y :unhighlight))
+	       (feedback last-window last-x last-y :unhighlight))
 	     (setq last-x x
-		   last-y y)
-	     (feedback x y :highlight))))
+		   last-y y
+		   last-window window)
+	     (feedback window x y :highlight))))
 	(when last-x
-	  (feedback last-x last-y :unhighlight)))
+	  (feedback last-window last-x last-y :unhighlight)))
       ;; The user has put down the presentation, figure out what to do
-      ;; 
-      (let ((translator (find-translator destination)))
+      ;;--- What if there is more than one translator?
+      (let ((translator (find-translator destination last-window last-x last-y)))
 	(when translator
 	  (multiple-value-bind (result-object result-type options)
 	      (funcall (presentation-translator-real-body translator)
 		       object presentation context-type
-		       frame event window x y
+		       frame event last-window last-x last-y
 		       (presentation-object destination) destination)
 	    (setq result-type (or result-type (evacuate-list context-type)))
 	    ;; Find the tag to throw to, and do so
diff --git a/clim/dragging-output.lisp b/clim/dragging-output.lisp
index 5838b4ab82ac60f1386fc91671c98c74807273b8..be5ba99d95b7b6ad4fdaffe3e31da77c2c481a67 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.7 92/04/15 11:46:27 cer Exp $
+;; $fiHeader: dragging-output.lisp,v 1.8 92/08/18 17:24:50 cer Exp $
 
 (in-package :clim-internals)
 
@@ -18,9 +18,11 @@
 			   :repaint ,repaint
 			   :finish-on-release ,finish-on-release))))
 
+(defparameter *dragging-output-finish-on-release* nil)
+
 (defun drag-output-record (stream output-record
 			   &key (repaint t) (erase #'erase-output-record) feedback
-				(finish-on-release nil))
+				(finish-on-release *dragging-output-finish-on-release*))
   (declare (values final-x final-y delta-x delta-y))
   (let (last-x last-y
 	(delta-x 0)
diff --git a/clim/formatted-output-defs.lisp b/clim/formatted-output-defs.lisp
index dbda914358ecd9f60c3ca546b333ebcb6429d8d5..d0cf622f88e47a93a541ba5b21f5d02d77f782e9 100644
--- a/clim/formatted-output-defs.lisp
+++ b/clim/formatted-output-defs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: formatted-output-defs.lisp,v 1.5 92/09/24 09:38:45 cer Exp $
+;; $fiHeader: formatted-output-defs.lisp,v 1.6 92/10/02 15:19:24 cer Exp $
 
 (in-package :clim-internals)
 
@@ -57,11 +57,11 @@
 				      n-columns n-rows
 				      max-width max-height
 				      stream-width stream-height
-				      (move-cursor T))
+				      (row-wise t) (move-cursor t))
 				&body body)
   (declare (ignore x-spacing y-spacing initial-spacing
 		   record-type n-columns n-rows max-width max-height
-		   stream-width stream-height move-cursor))
+		   stream-width stream-height row-wise move-cursor))
   #+Genera (declare (zwei:indentation 0 3 1 1))
   (default-output-stream stream formatting-item-list)
   `(flet ((formatting-item-list-body (,stream) ,@body))
diff --git a/clim/frames.lisp b/clim/frames.lisp
index c7b03c90ab0834d258b43a32b0676cff4c719977..da21ecf5cda25463c404661f3b7640a70544c59b 100644
--- a/clim/frames.lisp
+++ b/clim/frames.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: frames.lisp,v 1.47 92/10/12 17:54:23 cer Exp $
+;; $fiHeader: frames.lisp,v 1.48 92/10/28 11:31:36 cer Exp $
 
 (in-package :clim-internals)
 
@@ -67,9 +67,6 @@
 (defmethod graft ((frame standard-application-frame))
   (graft (frame-manager frame)))
 
-(defmethod frame-palette ((frame standard-application-frame))
-  (frame-manager-palette (frame-manager frame)))
-
 ;;--- These should really be somewhere else
 (defmethod frame-manager ((stream standard-encapsulating-stream))
   (frame-manager (encapsulating-stream-stream stream)))
@@ -101,6 +98,16 @@
     (when frame-manager
       (adopt-frame frame-manager frame))))
 
+(defmethod find-named-color (name (frame standard-application-frame) &key (errorp t))
+  (find-named-color name (frame-palette frame) :errorp errorp))
+
+(defmethod frame-palette ((frame standard-application-frame))
+  (let ((framem (frame-manager frame)))
+    (if framem
+	(frame-manager-palette framem)
+	(and (port frame)
+	     (port-default-palette (port frame))))))
+
 ;; Default method does nothing
 (defmethod generate-panes ((framem standard-frame-manager)
 			   (frame standard-application-frame))
@@ -704,11 +711,20 @@
   nil)
 
 
+(define-condition frame-exit (condition)
+  ((frame :initarg :frame :reader frame-exit-frame))
+  (:report (lambda (condition stream)
+	     (format stream "Exit from frame ~A" (frame-exit-frame condition)))))
+
 (defgeneric run-frame-top-level (frame &key &allow-other-keys))
 
 ;;--- It would be nice to have the CLIM 0.9 START-FRAME and STOP-FRAME functions
 (defmethod run-frame-top-level :around ((frame standard-application-frame) &key)
-  (with-simple-restart (frame-exit "Exit ~A" (frame-pretty-name frame))
+  (handler-bind ((frame-exit
+		   #'(lambda (condition)
+		       (let ((exit-frame (frame-exit-frame condition)))
+			 (when (eq frame exit-frame)
+			   (return-from run-frame-top-level nil))))))
     (unwind-protect
 	(let (;; Reset the state of the input editor and the presentation
 	      ;; type system, etc., in case there is an entry into another
@@ -759,6 +775,8 @@
       ;; top-level function to enable the frame.  For example, if we
       ;; called ENABLE-FRAME here, ACCEPTING-VALUES would disable the
       ;; wrong frame.  Sigh.
+      (queue-flush (frame-command-queue frame))
+      (queue-flush (sheet-event-queue (frame-top-level-sheet frame)))
       (disable-frame frame))))
 
 (defmethod run-frame-top-level ((frame standard-application-frame) &rest args)
@@ -854,7 +872,7 @@
 
 ;; Generic because someone might want :BEFORE or :AFTER
 (defmethod frame-exit ((frame standard-application-frame))
-  (invoke-restart 'frame-exit))
+  (signal 'frame-exit :frame frame))
 
 
 ;;; Sizing and moving of frames
diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp
index 7411fc43ee134801428dd2d7508dae671d20b79b..44714f976848152ac7d7e0fd10c6499901a37e2c 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.34 92/10/28 11:31:38 cer Exp Locker: cer $
+;; $fiHeader: gadget-output.lisp,v 1.35 92/10/29 15:02:40 cer Exp $
 
 (in-package :clim-internals)
 
@@ -240,6 +240,13 @@
 (defmethod note-output-record-detached :after ((record gadget-output-record))
   (update-output-record-gadget-state record nil))
 
+(defun move-cursor-to-view-position (stream view)
+  (let* ((initargs (view-gadget-initargs view))
+	 (x (getf initargs :x))
+	 (y (getf initargs :y)))
+    (when (and x y)
+      (stream-set-cursor-position stream x y))))
+
 
 (defvar *with-deferred-gadget-updates* nil)
 
@@ -271,7 +278,8 @@
 ;;; 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)
   ;;--- We can be clever and return different views depending on the
   ;;--- number of items, etc.
   +radio-box-view+)
@@ -352,8 +360,8 @@
 ;;; Subset completion gadget
 
 (define-presentation-method decode-indirect-view
-			    ((type subset-completion) (view
-						       gadget-dialog-view) (framem standard-frame-manager) &key)
+			    ((type subset-completion) (view gadget-dialog-view)
+			     (framem standard-frame-manager) &key)
   +check-box-view+)
 
 (define-presentation-method gadget-includes-prompt-p 
@@ -436,7 +444,7 @@
 
 (define-presentation-method decode-indirect-view
 			    ((type boolean) (view gadget-dialog-view)
-					    (framem standard-frame-manager) &key)
+			     (framem standard-frame-manager) &key)
   +toggle-button-view+)
 
 (define-presentation-method gadget-includes-prompt-p 
@@ -497,13 +505,6 @@
 		      stream query-identifier))))
 	  (values (outlining () slider) slider))))))
 
-
-(defun move-cursor-to-view-position (stream view)
-  (let* ((initargs (view-gadget-initargs view))
-	 (x (getf initargs :x))
-	 (y (getf initargs :y)))
-    (when (and x y) (stream-set-cursor-position stream x y))))
-
 (define-presentation-method accept-present-default 
 			    ((type integer) stream (view slider-view)
 			     default default-supplied-p present-p query-identifier
@@ -572,7 +573,8 @@
 
 ;; The string case is straightforward
 (define-presentation-method decode-indirect-view
-			    ((type string) (view gadget-dialog-view) (framem standard-frame-manager) &key)
+			    ((type string) (view gadget-dialog-view)
+			     (framem standard-frame-manager) &key)
   +text-field-view+)
 
 (define-presentation-method accept-present-default 
@@ -640,8 +642,7 @@
 
 (defun make-list/option-pane-for-ptype (pane-type stream view sequence 
 					name-key value-key test
-					default query-identifier type
-					printer mode)
+					default query-identifier type printer mode)
   (move-cursor-to-view-position stream view)
   (flet ((update-gadget (record gadget list-pane)
 	   (declare (ignore gadget record))
diff --git a/clim/gestures.lisp b/clim/gestures.lisp
index 13b9ce010cc9f637069b05a9cee457f08c69af1b..ac21a8fc7ce638b00f35fad6b027e957e04b8277 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.15 92/10/02 15:19:30 cer Exp $
+;; $fiHeader: gestures.lisp,v 1.16 92/10/28 11:31:40 cer Exp $
 
 (in-package :clim-internals)
 
@@ -17,12 +17,14 @@
 
 (eval-when (compile load eval)
 
+;; Button indices are 0, 1, or 2
 (defun-inline button-index (name)
   #+Genera (declare lt:(side-effects simple reducible))
   (position name *pointer-buttons*))
 (defun-inline button-index-name (index)
   (aref *pointer-buttons* index))
 
+;; Modifier key indices are 0, 1, 2, 3, or 4
 (defun-inline modifier-key-index (name)
   #+Genera (declare lt:(side-effects simple reducible))
   (position name *modifier-keys*))
@@ -87,7 +89,8 @@
   (do-button-and-modifier-state (button modifier-state bucket)
     (when (member gesture-name bucket)
       (return-from gesture-name-button-and-modifiers
-	(values button modifier-state))))
+	(values (ash 1 (+ (1- (integer-length +pointer-left-button+)) button))
+		modifier-state))))
   nil)
 
 (defun gesture-name-keysym-and-modifiers (gesture-name)
@@ -297,7 +300,8 @@
 				 (#\Escape . :escape)))))
       (cond (entry
 	     (setq keysym (cdr entry)))
-	    ((standard-char-p keysym) 
+	    ((and (characterp keysym)
+		  (standard-char-p keysym)) 
 	     (setq keysym (svref #(:space :\! :\" :\# :\$ :\% :\& :\'
 				   :\( :\) :\* :\+ :\, :\- :\. :\/
 				   :\0 :\1 :\2 :\3 :\4 :\5 :\6 :\7 :\8 :\9
diff --git a/clim/graph-formatting.lisp b/clim/graph-formatting.lisp
index 4a84733b141e95083a4b0db4410b6666c76ca8da..aaa84c482b5c59dc24a5e6fc8b27212eb699f4cf 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.16 92/10/02 15:19:32 cer Exp $
+;; $fiHeader: graph-formatting.lisp,v 1.17 92/10/28 11:31:42 cer Exp $
 
 (In-package :clim-internals)
 
@@ -31,13 +31,14 @@
 
 (defun make-graph-node-table (&key (test 'eql) (size 50))
   (let ((table
-	  (and (or (member test '(eq eql equal equalp
+	  (and (or (member test '(eq eql equal 
+				  #-Cloe-Runtime equalp
 				  #+Genera string-equal #+Genera string=
 				  #+Genera char-equal #+Genera char=))
 		   (eq test (load-time-value #'eq))
 		   (eq test (load-time-value #'eql))
 		   (eq test (load-time-value #'equal))
-		   (eq test (load-time-value #'equalp)))
+		   #-Cloe-Runtime (eq test (load-time-value #'equalp)))
 	       (make-hash-table :test test :size size))))
     (make-instance 'graph-node-table
       :test test :table table)))
@@ -227,6 +228,38 @@
   (declare (ignore from-node to-node))
   (apply #'draw-line* stream x1 y1 x2 y2 drawing-options))
 
+(defun-inline call-arc-drawer (stream arc-drawer from-node to-node
+			       parent parent-x parent-y child child-x child-y
+			       arc-drawing-options)
+  (declare (dynamic-extent arc-drawer))
+  (if (or (stream-redisplaying-p stream)
+	  (stream-current-redisplay-record stream))
+      (call-arc-drawer-1 stream arc-drawer from-node to-node
+			 parent parent-x parent-y child child-x child-y
+			 arc-drawing-options)
+      (apply arc-drawer stream from-node to-node
+	     parent-x parent-y child-x child-y
+	     arc-drawing-options)))
+
+;; Split out to avoid consing a closure environment
+(defun call-arc-drawer-1 (stream arc-drawer from-node to-node
+			  parent parent-x parent-y child child-x child-y
+			  arc-drawing-options)
+  (declare (dynamic-extent arc-drawer))
+  #---ignore	;--- this is the wrong thing...
+  (apply arc-drawer stream from-node to-node
+	 parent-x parent-y child-x child-y
+	 arc-drawing-options)
+  #+++ignore	;--- ...but the right thing doesn't work either
+  (updating-output (stream :unique-id (list parent child)
+			   :id-test #'equal
+			   :cache-value (list parent-x parent-y
+					      child-x child-y)
+			   :cache-test #'equal)
+    (apply arc-drawer stream from-node to-node
+	   parent-x parent-y child-x child-y
+	   arc-drawing-options)))
+
 
 ;;; Tree graphs
 
@@ -364,10 +397,12 @@
 				   (child-attachment-position child)
 				 (translate-coordinates xoff yoff
 				   parent-x parent-y child-x child-y)
-				 (apply arc-drawer stream
-					nil nil	;--- should be from-node and to-node
-					parent-x parent-y child-x child-y
-					arc-drawing-options))))))
+				 (call-arc-drawer stream arc-drawer
+						  ;;--- Should be from- and to-node
+						  nil nil
+						  parent parent-x parent-y
+						  child child-x child-y
+						  arc-drawing-options))))))
 		  (declare (dynamic-extent #'draw-edges))
 		  (draw-edges root-node))))))))))
 
@@ -598,10 +633,12 @@
 				     (funcall child-attach child)
 				   (translate-coordinates xoff yoff
 				     parent-x parent-y child-x child-y)
-				   (apply arc-drawer stream 
-					  nil nil	;--- should be from-node and to-node
-					  parent-x parent-y child-x child-y
-					  arc-drawing-options))))))
+				   (call-arc-drawer stream arc-drawer
+						    ;;--- Should be from- and to-node
+						    nil nil
+						    parent parent-x parent-y
+						    child child-x child-y
+						    arc-drawing-options))))))
 		    (declare (dynamic-extent #'draw-edge)) 
 		    (traverse-graph root-nodes #'inferior-mapper
 				    hash-table #'identity
diff --git a/clim/graphics-recording.lisp b/clim/graphics-recording.lisp
index 493c4318072415aacbb462c6763f6e855a97e2d5..4c573fb0e10cac0b7dd39b0c948ba234446a595a 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.13 92/08/19 10:24:02 cer Exp $
+;; $fiHeader: graphics-recording.lisp,v 1.14 92/09/08 15:17:51 cer Exp $
 
 (in-package :clim-internals)
 
@@ -47,12 +47,14 @@
 	     (remove 'filled (append medium-components function-args)))
 	   (slot-descs 
 	     (mapcar #'(lambda (x)
-			 (list x :initarg (intern (symbol-name x) *keyword-package*)))
-			 slots)))
+			 (let ((keyword (intern (symbol-name x) *keyword-package*)))
+			   (if (eq keyword :ink)
+			       `(,x :initarg ,keyword :accessor displayed-output-record-ink)
+			       `(,x :initarg ,keyword))))
+		     slots)))
       `(progn
 	 (defclass ,class ,superclasses ,slot-descs)
-	 (define-constructor-using-prototype-instance
-	   ,constructor ,class ,slots
+	 (define-constructor-using-prototype-instance ,constructor ,class ,slots
 	   ,@(mapcar #'(lambda (arg) 
 			 `(,arg ,(intern (symbol-name arg) *keyword-package*) ,arg)) 
 		     slots))
diff --git a/clim/input-editor-commands.lisp b/clim/input-editor-commands.lisp
index 53280f69aa1fab467ede044f164c63dbcefad386..89723f9f6df33cf70486fbdf260f4b9652a18885 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.20 92/10/28 11:31:43 cer Exp Locker: cer $
+;; $fiHeader: input-editor-commands.lisp,v 1.21 92/10/29 15:02:42 cer Exp $
 
 (in-package :clim-internals)
 
@@ -31,19 +31,19 @@
 	     (when keysym
 	       (if (zerop modifier-state)
 		   ;;--- What a kludge!  What should this really be?
-		   (member keysym '(:rubout :clear-input :escape
-				    :scroll :refresh :suspend :resume))
+		   (member keysym '(:rubout :clear-input :escape :scroll :refresh :suspend
+					    :resume :page-up :page-down :clear :backspace))
 		   (logtest modifier-state
 			    (make-modifier-state :control :meta :super :hyper)))))))
     (declare (dynamic-extent #'add-aarray-entry #'bucky-char-p))
     (cond ((atom gestures)
 	   (assert (bucky-char-p gestures) (gestures)
-		   "~S does not correspond to a gesture" gestures)
+		   "~S does not correspond to non-printing gesture" gestures)
 	   (add-aarray-entry gestures function *input-editor-command-aarray*))
 	  (t
 	   (assert (> (length gestures) 1))
 	   (assert (bucky-char-p (first gestures)) (gestures)
-		   "~S does not correspond to a gesture" gestures)
+		   "~S does not correspond to non-printing gesture" gestures)
 	   ;; We've got a command that wil be bound to a sequence of gestures,
 	   ;; so set up the prefix tables.
 	   (let ((aarray *input-editor-command-aarray*))
@@ -1232,6 +1232,17 @@
   (:ie-show-value	    :v   :meta :shift)
   (:ie-show-documentation   :d   :meta :shift))
 
+#+Cloe-Runtime
+(define-input-editor-gestures
+  (:ie-rubout-character     :backspace)
+  (:ie-rubout-word	    :backspace :meta)
+  (:ie-rubout-sexp	    :backspace :control :meta)
+  (:ie-clear-input	    :clear)
+  (:ie-scroll-forward	    :page-down)
+  (:ie-scroll-backward	    :page-up)
+  (:ie-scroll-left	    :page-up :super)
+  (:ie-scroll-right	    :page-down :super))
+
 
 (defmacro assign-input-editor-key-bindings (&body functions-and-gestures)
   (let ((forms nil))
diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp
index 4e157eac7f98de24187d47d8025b57ae8b54b20c..aa37e7b2a8f13792a672dfdf52b13f05244abe08 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.29 92/10/28 11:31:46 cer Exp Locker: cer $
+;; $fiHeader: input-protocol.lisp,v 1.30 92/10/28 13:17:22 cer Exp $
 
 (in-package :clim-internals)
 
@@ -53,10 +53,9 @@
 	;; A "normal" gesture
 	(return-from stream-read-gesture
 	  (values gesture flag)))
-      ;; If we're looping when PEEK-P is T, we have to eat the
-      ;; gesture.
-      ;;--- what if peek-p is t and another gesture has arrived
-      ;; between the last call-next-method and this one??? (cim)
+      ;; If we're looping when PEEK-P is T, we have to eat the gesture.
+      ;;--- What if PEEK-P is T and another gesture has arrived
+      ;;--- between the last call-next-method and this one? (cim)
       (call-next-method stream :timeout 0 :peek-p nil))))
 
 ;;; Our implementation of the extended-input protocol.
@@ -101,8 +100,8 @@
       (cursor-set-position cursor x y t))))
 
 
-(defmethod initialize-menu :before (port (menu input-protocol-mixin) associated-window)
-  (declare (ignore port associated-window))
+(defmethod initialize-menu :before (port (menu input-protocol-mixin) &key label)
+  (declare (ignore port label))
   (let ((cursor (stream-text-cursor menu)))
     (when cursor
       (setf (cursor-active cursor) nil))))
@@ -153,7 +152,9 @@
 (defmethod queue-event ((stream input-protocol-mixin) (event key-press-event))
   (let ((char (keyboard-event-character event))
 	(keysym (keyboard-event-key-name event)))
-    (cond ((and (characterp char) (ordinary-char-p char))
+    (cond ((and (characterp char) 
+		(or (ordinary-char-p char)
+		    (diacritic-char-p char)))
 	   (queue-put (stream-input-buffer stream) char))
 	  ((and keysym (not (typep keysym 'modifier-keysym)))
 	   (queue-put (stream-input-buffer stream) (copy-event event)))
@@ -257,7 +258,7 @@
 			 (new-gesture 
 			   (receive-gesture
 			     (if (or (null sheet) (eq sheet stream))
-				 (or *original-stream* stream)
+				 (encapsulated-stream stream)
 				 sheet)
 			     gesture)))
 		    (when new-gesture
@@ -411,15 +412,17 @@
     (loop
       ;; Don't pass off a pointer-button-press-handler that ignores clicks,
       ;; we want this to be runnable inside a WITH-INPUT-CONTEXT.
-      (setq gesture (stream-read-gesture (or *original-stream* stream)))
-      (when (and (characterp gesture) (ordinary-char-p gesture))
+      (setq gesture (stream-read-gesture (encapsulated-stream stream)))
+      (when (and (characterp gesture)
+		 (or (ordinary-char-p gesture)
+		     (diacritic-char-p gesture)))
 	(return-from stream-read-char gesture))
       ;;--- Probably wrong.  It prevents the input editor from ever seeing
       ;;--- mouse clicks, for example.
       (beep stream))))
 
 (defmethod stream-unread-char ((stream input-protocol-mixin) character)
-  (stream-unread-gesture (or *original-stream* stream) character))
+  (stream-unread-gesture (encapsulated-stream stream) character))
 
 ;;; Again, we only need this function (as opposed to using :timeout)
 ;;; because the X3J13 proposal includes it explicitly.
@@ -428,16 +431,18 @@
     (loop
       ;; Don't pass off a pointer-button-press-handler that ignores clicks,
       ;; we want this to be runnable inside a WITH-INPUT-CONTEXT.
-      (setq gesture (stream-read-gesture (or *original-stream* stream) :timeout 0))
+      (setq gesture (stream-read-gesture (encapsulated-stream stream) :timeout 0))
       (when (or (null gesture) 
-		(and (characterp gesture) (ordinary-char-p gesture)))
+		(and (characterp gesture)
+		     (or (ordinary-char-p gesture)
+			 (diacritic-char-p gesture)) ))
 	(return-from stream-read-char-no-hang gesture)))))
 
 (defmethod stream-peek-char ((stream input-protocol-mixin))
   ;; stream-listen used to return the char, but Hornig says it has to return T
   (or nil ;(stream-listen stream)
-      (let ((char (stream-read-char (or *original-stream* stream))))
-	(prog1 char (stream-unread-gesture (or *original-stream* stream) char)))))
+      (let ((char (stream-read-char (encapsulated-stream stream))))
+	(prog1 char (stream-unread-gesture (encapsulated-stream stream) char)))))
 
 ;;; We think that the "standard" demands that this only see characters.
 ;;; However, it does not want to flush any pending action elements that
@@ -450,7 +455,9 @@
     ;; map over the input buffer looking for characters.  
     ;; If we find one, return true
     (flet ((find-char (gesture)
-	     (when (and (characterp gesture) (ordinary-char-p gesture))
+	     (when (and (characterp gesture) 
+			(or (ordinary-char-p gesture)
+			    (diacritic-char-p gesture)))
 	       (return-from stream-listen t))))
       (declare (dynamic-extent #'find-char))
       (map-over-queue #'find-char input-buffer))
@@ -473,7 +480,8 @@
 		   (evacuate-temporary-string result)))
 		(t
 		 ;; Be robust against weird characters
-		 (if (ordinary-char-p ch)
+		 (if (or (ordinary-char-p ch)
+			 (diacritic-char-p ch))
 		     (vector-push-extend ch result)
 		     (beep stream))))
 	  (setq ch (stream-read-char stream)))))))
@@ -553,7 +561,7 @@
 
 #+Genera
 (defun stream-compatible-any-tyi-1 (stream timeout eof)
-  (let ((character (stream-read-gesture (or *original-stream* stream) :timeout timeout)))
+  (let ((character (stream-read-gesture (encapsulated-stream stream) :timeout timeout)))
     (cond ((null character) nil)
 	  ((eq character *end-of-file-marker*) 
 	   (and eof (error "~a" eof)))
diff --git a/clim/interactive-defs.lisp b/clim/interactive-defs.lisp
index e07d8de3c189cab21d2fdcdaa088a6a7e1b47846..052e4b19473b69fe82bdf3a7beb341eb621fbbe4 100644
--- a/clim/interactive-defs.lisp
+++ b/clim/interactive-defs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: interactive-defs.lisp,v 1.16 92/09/24 09:39:06 cer Exp $
+;; $fiHeader: interactive-defs.lisp,v 1.17 92/10/02 15:19:40 cer Exp $
 
 (in-package :clim-internals)
 
@@ -166,7 +166,8 @@
 		       ((delimiter-gesture-p gesture)
 			;; ditto?
 			(return-token gesture))
-		       ((ordinary-char-p gesture)
+		       ((or (ordinary-char-p gesture)
+			    (diacritic-char-p gesture))
 			(vector-push-extend gesture string)
 			;;--- haven't updated WRITE-CHAR yet
 			#+++ignore (write-char gesture stream))
diff --git a/clim/interactive-protocol.lisp b/clim/interactive-protocol.lisp
index 64fa3b1abb3993260c1f58b18a51e298fc30b741..c0befe358e95d469d3d0efbfa7e62f4e81296e86 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.19 92/10/02 15:19:42 cer Exp $
+;; $fiHeader: interactive-protocol.lisp,v 1.20 92/10/28 11:31:47 cer Exp $
 
 (in-package :clim-internals)
 
@@ -221,24 +221,29 @@
 		   (write-string (noise-string-display-string noise-string) istream))
 		 (noise-string-unique-id noise-string)))))))
 
-(defmethod stream-accept ((istream input-editing-stream-mixin)
-			  type &rest args &key query-identifier &allow-other-keys)
-  (declare (dynamic-extent args))
+(defmethod stream-accept ((istream input-editing-stream-mixin) type &rest accept-args
+			  &key view &allow-other-keys)
+  (declare (dynamic-extent accept-args))
   (with-slots (input-buffer scan-pointer insertion-pointer
 	       previous-history previous-insertion-pointer) istream
-    (unless (stream-rescanning-p istream)
-      ;; If we're not rescanning, reset these so that m-Y will not work
-      ;; until the user types c-Y or c-m-Y.
-      (setq previous-history nil
-	    previous-insertion-pointer nil))
-    (let ((next-char (and (< scan-pointer insertion-pointer)
-			  (aref input-buffer scan-pointer))))
-      (cond ((and (typep next-char 'accept-result)
-		  (eql (noise-string-unique-id next-char) query-identifier))
-	     (incf scan-pointer)
-	     (values (accept-result-presentation-object next-char)
-		     (accept-result-presentation-type next-char)))
-	    (t (apply #'accept-1 (or *original-stream* istream) type args))))))
+    (let ((query-identifier
+	    (apply #'prompt-for-accept
+		   (encapsulated-stream istream) type view accept-args)))
+      (unless (stream-rescanning-p istream)
+	;; If we're not rescanning, reset these so that m-Y will not work
+	;; until the user types c-Y or c-m-Y.
+	(setq previous-history nil
+	      previous-insertion-pointer nil))
+      (let ((next-char (and (< scan-pointer insertion-pointer)
+			    (aref input-buffer scan-pointer))))
+	(cond ((and (typep next-char 'accept-result)
+		    (eql (noise-string-unique-id next-char) query-identifier))
+	       (incf scan-pointer)
+	       (values (accept-result-presentation-object next-char)
+		       (accept-result-presentation-type next-char)))
+	      (t (apply #'accept-1 (encapsulated-stream istream) type 
+				   :query-identifier query-identifier
+				   accept-args)))))))
 
 (defmethod input-buffer-input-position->cursor-position ((istream input-editing-stream-mixin)
 							 &optional position)
@@ -487,7 +492,8 @@
 		   (stream-process-gesture istream thing type)
 		 (when (and (characterp new-thing)
 			    ;; Don't put things in the buffer that we can't echo later
-			    (ordinary-char-p new-thing)
+			    (or (ordinary-char-p new-thing)
+				(diacritic-char-p new-thing))
 			    (not (activation-gesture-p new-thing)))
 		   ;; If we are inserting multiple copies of this character
 		   ;; we'll need to do a rescan in order to keep user-level
@@ -534,7 +540,8 @@
 				(t (setf insertion-pointer (fill-pointer input-buffer))
 				   (setf activation-gesture new-thing))))
 			 ((or (not (characterp new-thing))
-			      (ordinary-char-p new-thing))
+			      (ordinary-char-p new-thing)
+			      (diacritic-char-p new-thing))
 			  ;; There might be some queued up rescans from destructive
 			  ;; input editing commands, so take care of them now
 			  (rescan-if-necessary istream t)
diff --git a/clim/menus.lisp b/clim/menus.lisp
index e684a442e08b226c98e23025333dfc6a4a7beb17..0212b0d096aa2716c64084ee139f79976cb51e45 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.33 92/10/28 11:31:49 cer Exp Locker: cer $
+;; $fiHeader: menus.lisp,v 1.34 92/10/28 13:17:24 cer Exp $
 
 (in-package :clim-internals)
 
@@ -9,14 +9,22 @@
 
 (defvar *abort-menus-when-buried* t)
 
+(defparameter *default-menu-text-style* (make-text-style :fix :roman :normal))
+(defparameter *default-menu-label-text-style* (make-text-style :fix :italic :normal))
+
 (define-application-frame menu-frame ()
-    (menu)
+    (menu label)
   (:pane
-    (with-slots (menu) *application-frame*
+    (with-slots (menu label) *application-frame*
       (outlining ()
-	(scrolling ()
-	  (setq menu (make-pane 'clim-stream-pane
-		       :initial-cursor-visibility nil))))))
+	(vertically ()
+	  (setq label (make-pane 'label-pane 
+			:label ""
+			:text-style *default-menu-label-text-style*))
+	  (scrolling ()
+	    (setq menu (make-pane 'clim-stream-pane
+			 :initial-cursor-visibility nil)))))))
+
   (:menu-bar nil))
 
 (defmethod frame-calling-frame ((frame menu-frame))
@@ -33,18 +41,23 @@
     (setf (getf (frame-properties frame) :menu-frame) t)
     (values (slot-value frame 'menu) frame)))
 
-(defresource menu (associated-window root)
+(defresource menu (associated-window root &key label)
   :constructor (let* ((port (if (null root) (find-port) (port root))))
 		 (get-menu :port port))
   :deinitializer (window-clear menu)
-  :initializer (initialize-menu (port menu) menu associated-window)
+  :initializer (initialize-menu (port menu) menu :label label)
   ;; Horrible kludge in the case where no associated window is passed in.
   :matcher (eq (port menu) (port root)))
 
-(defmethod initialize-menu ((port basic-port) menu associated-window)
-  (declare (ignore menu associated-window))
+(defmethod initialize-menu ((port basic-port) menu &key label)
   ;;--- Should this flush the menu's event queue?
-  )
+  (let ((text-style (if (listp label) 
+			(getf (rest label) :text-style *default-menu-label-text-style*)
+			*default-menu-label-text-style*))
+	(label (if (listp label) (first label) label))
+	(label-pane (slot-value (pane-frame menu) 'label)))
+    (setf (gadget-label label-pane) (or label "")
+	  (pane-text-style label-pane) (parse-text-style text-style))))
 
 
 ;; items := (item*)
@@ -67,8 +80,8 @@
 	  ((atom (setq rest (cdr menu-item))) default)
 	  (t (getf rest indicator default)))))
 
-(defun menu-item-style (menu-item)
-  (menu-item-getf menu-item :style))
+(defun menu-item-text-style (menu-item)
+  (menu-item-getf menu-item :text-style))
 
 (defun menu-item-documentation (menu-item)
   (menu-item-getf menu-item :documentation))
@@ -132,13 +145,13 @@
 (defun draw-standard-menu (menu presentation-type items default-item
 			   &key (item-printer #'print-menu-item)
 				max-width max-height n-rows n-columns
-				x-spacing y-spacing 
+				x-spacing y-spacing (row-wise nil)
 				(cell-align-x ':left) (cell-align-y ':top)
 			   &aux default-presentation)
   (formatting-item-list (menu :max-width max-width :max-height max-height
 			      :n-rows n-rows :n-columns n-columns
 			      :x-spacing x-spacing :y-spacing y-spacing
-			      :move-cursor nil)
+			      :row-wise row-wise :move-cursor nil)
     (flet ((format-item (item)
 	     (let ((type (menu-item-type item)))
 	       (flet ((print-item ()
@@ -177,7 +190,7 @@
 (defun print-menu-item (menu-item &optional (stream *standard-output*))
   (let ((display (menu-item-display menu-item))
 	(string nil)
-	(style (menu-item-style menu-item)))
+	(style (menu-item-text-style menu-item)))
     (cond ((stringp display)
 	   (setq string display))
 	  ;; This is a [horrible] kludge to get around the fact
@@ -198,13 +211,13 @@
      ;; In case we need to "compile" the menu on the fly
      (items :initarg :items)
      (default-item :initarg :default-item)
-     (default-style :initarg :default-style)
+     (text-style :initarg :text-style)
      (printer :initarg :printer)
      (presentation-type :initarg :presentation-type)
      (drawer-args :initarg :drawer-args)))
 
 (defgeneric menu-choose (items &rest keys
-			 &key associated-window default-item default-style
+			 &key associated-window text-style default-item
 			      label printer presentation-type
 			      cache unique-id id-test cache-value cache-test
 			      max-width max-height n-rows n-columns
@@ -215,21 +228,21 @@
 ;; Are these reasonable defaults for UNIQUE-ID, CACHE-VALUE, ID-TEST, and CACHE-TEST?
 (defmethod menu-choose ((items t) &rest keys
 			&key (associated-window (frame-top-level-sheet *application-frame*))
-			     default-item default-style
+			     text-style default-item
 			     label printer presentation-type
 			     (cache nil) (unique-id items) (id-test #'equal)
 			     (cache-value items) (cache-test #'equal)
 			     max-width max-height n-rows n-columns
-			     x-spacing y-spacing 
+			     x-spacing y-spacing (row-wise nil)
 			     (cell-align-x ':left) (cell-align-y ':top)
 			     pointer-documentation)
   (declare (values value chosen-item gesture))
   (declare (ignore associated-window
-		   default-item default-style
+		   text-style default-item
 		   label printer presentation-type
 		   cache unique-id id-test cache-value cache-test
 		   max-width max-height n-rows n-columns
-		   x-spacing y-spacing cell-align-x cell-align-y
+		   x-spacing y-spacing row-wise cell-align-x cell-align-y
 		   pointer-documentation))
   (declare (dynamic-extent keys))
   (unless (zerop (length items))
@@ -241,12 +254,12 @@
 	   ((framem standard-frame-manager) items &rest keys
 	    &key (associated-window
 		   (frame-top-level-sheet *application-frame*))
-		 default-item default-style
+		 text-style default-item
 		 label printer presentation-type
 		 (cache nil) (unique-id items) (id-test #'equal)
 		 (cache-value items) (cache-test #'equal)
 		 max-width max-height n-rows n-columns
-		 x-spacing y-spacing 
+		 x-spacing y-spacing (row-wise nil)
 		 (cell-align-x ':left) (cell-align-y ':top)
 		 pointer-documentation)
   (declare (values value chosen-item gesture))
@@ -260,10 +273,9 @@
 	  ;; Lucid production compiler tries to use an undefined internal
 	  ;; variable if this LET isn't done.
 	  #+Lucid (items items))
-      (with-menu (menu associated-window)
-	(setf (window-label menu) label)
+      (with-menu (menu associated-window :label label)
 	(reset-frame (pane-frame menu) :title label)
-	(with-text-style (menu default-style)
+	(with-text-style (menu text-style)
 	  (with-end-of-line-action (menu :allow)
 	    (loop
 	      (multiple-value-bind (item gesture)
@@ -273,6 +285,7 @@
 					       :max-width max-width :max-height max-height
 					       :n-rows n-rows :n-columns n-columns
 					       :x-spacing x-spacing :y-spacing y-spacing 
+					       :row-wise row-wise
 					       :cell-align-x cell-align-x
 					       :cell-align-y cell-align-y)))
 		    (declare (dynamic-extent #'menu-choose-body))
@@ -383,7 +396,7 @@
 	(with-menu-as-popup (menu)
 	  (position-sheet-near-pointer
 	    (frame-top-level-sheet (pane-frame menu)) x-position y-position)
-	  (window-expose menu)
+	  (setf (window-visibility menu) t)
  	  ;;--- If we have windows with backing store then we dont get
  	  ;;--- exposure event and so nothing appears
  	  #+Allegro (replay (stream-output-history menu) menu)
@@ -398,16 +411,12 @@
 	    (with-input-context (presentation-type :override T)
 				(object type gesture)
 		 (labels ((input-wait-test (menu)
-			    ;; Wake up if the menu becomes buried, or
-			    ;; if highlighting is needed
-			    ;; this screws up in Allegro because
-			    ;; querying the server in the wait
-			    ;; function screws event handling.
+			    ;; Wake up if the menu becomes buried, or if highlighting
+			    ;; is needed.
+			    ;;--- This screws up in Allegro because querying the server
+			    ;;--- in the wait function screws event handling.
 			    (or #-Allegro 
 				(and *abort-menus-when-buried*
-				     #+Cloe-Runtime
-				     (not (stream-has-input-focus menu))
-				     #-Cloe-Runtime
 				     (not (window-visibility menu)))
 				(pointer-motion-pending menu)))
 			  (input-wait-handler (menu)
@@ -437,14 +446,14 @@
 (defun hierarchical-menu-choose (items
 				 &key (associated-window
 					(frame-top-level-sheet *application-frame*))
-				      default-item default-style
+				      text-style default-item
 				      label printer presentation-type
 				      x-position y-position
 				      (cache nil)
 				      (unique-id items) (id-test #'equal)
 				      (cache-value items) (cache-test #'equal)
 				      max-width max-height n-rows n-columns
-				      x-spacing y-spacing 
+				      x-spacing y-spacing (row-wise nil)
 				      (cell-align-x ':left) (cell-align-y ':top))
   (declare (values value chosen-item gesture))
   (flet ((present-item (item stream)
@@ -453,9 +462,8 @@
     (let ((item-printer (cond (presentation-type #'present-item)
 			      (printer printer)
 			      (t #'print-menu-item))))
-      (with-menu (menu associated-window)
-	(setf (window-label menu) label)
-	(with-text-style (menu default-style)
+      (with-menu (menu associated-window :label label)
+	(with-text-style (menu text-style)
 	  (multiple-value-bind (item gesture)
 	      (flet ((menu-choose-body (stream presentation-type)
 		       (draw-standard-menu stream presentation-type items default-item
@@ -463,6 +471,7 @@
 					   :max-width max-width :max-height max-height
 					   :n-rows n-rows :n-columns n-columns
 					   :x-spacing x-spacing :y-spacing y-spacing 
+					   :row-wise row-wise
 					   :cell-align-x cell-align-x
 					   :cell-align-y cell-align-y)))
 		(declare (dynamic-extent #'menu-choose-body))
@@ -480,7 +489,7 @@
 		     (hierarchical-menu-choose
 		       (menu-item-items item)
 		       :associated-window associated-window
-		       :default-style default-style
+		       :text-style text-style
 		       :x-position mr :y-position mt
 		       :cache cache
 		       :unique-id unique-id :id-test id-test
@@ -497,29 +506,29 @@
 
 (defmacro define-static-menu (name root-window items
 			      &rest keys
-			      &key default-item default-style
+			      &key text-style default-item
 				   printer presentation-type
 				   max-width max-height n-rows n-columns
-				   x-spacing y-spacing 
+				   x-spacing y-spacing (row-wise nil)
 				   (cell-align-x ':left) (cell-align-y ':top))
   (declare (ignore max-width max-height n-rows n-columns
-		   x-spacing y-spacing cell-align-x cell-align-y))
+		   x-spacing y-spacing row-wise cell-align-x cell-align-y))
   (with-keywords-removed (drawer-keys keys
-			  '(:default-item :default-style :printer :presentation-type))
+			  '(:text-style :default-item :printer :presentation-type))
     `(defvar ,name (define-static-menu-1 ',name ,root-window ',items
 					 :default-item ',default-item
-					 :default-style ',default-style
+					 :text-style ',text-style
 					 :presentation-type ',presentation-type
 					 :printer ',printer
 					 :drawer-args ,(copy-list drawer-keys)))))
 
 (defun define-static-menu-1 (name root-window items
-			     &key default-item default-style
+			     &key text-style default-item
 				  printer presentation-type
 				  drawer-args)
   (let ((menu-contents nil)
 	(default-presentation nil))
-    (when (typep root-window 'window-mixin)
+    (when (windowp root-window)
       ;; Build the static menu if we can
       (flet ((present-item (item stream)
 	       (present item presentation-type :stream stream)))
@@ -528,7 +537,7 @@
 				  (printer printer)
 				  (t #'print-menu-item))))
 	  (with-menu (menu root-window)
-	    (with-text-style (menu default-style)
+	    (with-text-style (menu text-style)
 	      (with-end-of-line-action (menu :allow)
 		(with-output-recording-options (menu :draw nil :record t)
 		  (setq menu-contents
@@ -546,7 +555,7 @@
       ;; Save this in case we have to rebuild the menu
       :items items
       :default-item default-item
-      :default-style default-style
+      :text-style text-style
       :printer printer
       :presentation-type presentation-type
       :drawer-args drawer-args)))
@@ -555,7 +564,7 @@
 (defmethod menu-choose ((static-menu static-menu)
 			&rest keys
 			&key (associated-window (frame-top-level-sheet *application-frame*))
-			     label default-style pointer-documentation
+			     label text-style pointer-documentation
 			&allow-other-keys)
   (declare (values value chosen-item gesture))
   (declare (dynamic-extent keys))
@@ -566,20 +575,19 @@
 		(null menu-contents))
 	;; If the root for the static menu is not the current root or the static
 	;; menu has never been filled in, then we have to recompute its contents.
-	(with-slots (default-item default-style printer presentation-type drawer-args)
+	(with-slots (default-item text-style printer presentation-type drawer-args)
 		    static-menu
 	  (let ((new-menu (define-static-menu-1 name this-root items
 						:default-item default-item
-						:default-style default-style
+						:text-style text-style
 						:printer printer 
 						:presentation-type presentation-type
 						:drawer-args drawer-args)))
 	    (setq menu-contents (slot-value new-menu 'menu-contents)
 		  default-presentation (slot-value new-menu 'default-presentation)
 		  root-window this-root)))))
-    (with-menu (menu associated-window)
-      (setf (window-label menu) label)
-      (with-text-style (menu default-style)
+    (with-menu (menu associated-window :label label)
+      (with-text-style (menu text-style)
 	(multiple-value-bind (item gesture)
 	    (menu-choose-from-drawer 
 	      menu 'menu-item #'false		;the drawer never gets called
diff --git a/clim/output-protocol.lisp b/clim/output-protocol.lisp
index 205caa51e3ef820c7d759d2ba3a06374dfd477b3..14e4490f8f34cc73ac8d9f5b5c3d90b54a894480 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.25 92/10/02 15:19:46 cer Exp $
+;; $fiHeader: output-protocol.lisp,v 1.26 92/10/28 11:31:51 cer Exp $
 
 (in-package :clim-internals)
 
@@ -239,11 +239,6 @@
 ;;--- It would be nice to put them on something a bit more specific,
 ;;--- but OUTPUT-PROTOCOL-MIXIN is too specific.  Sigh.
 
-;;; For "normal" output streams, there are no margins.
-(defmethod window-margins ((stream t))
-  (values (coordinate 0) (coordinate 0)
-	  (coordinate 0) (coordinate 0)))
-
 ;;; "Normal" output streams are never recording.
 (defmethod stream-recording-p ((stream t)) nil)
 
@@ -667,6 +662,7 @@
 		  ((eql write-char #\Tab)
 		   (setf cursor-x (stream-next-tab-column stream cursor-x style))
 		   (maxf largest-x cursor-x))
+		  ((diacritic-char-p write-char))
 		  (t
 		   (multiple-value-bind (new-cursor-x new-cursor-y new-baseline new-height)
 		       (stream-draw-lozenged-character 
@@ -755,14 +751,14 @@
 	  (wrap-p (unless brief-p (eq (stream-end-of-line-action stream) ':wrap))))
       (if brief-p
 	  (values cursor-x cursor-y baseline line-height)
-	(values cursor-x cursor-y baseline line-height
-		(medium-merged-text-style stream)
-		(cond ((and wrap-p
-			    (stream-text-margin stream)))
-		      (t +largest-coordinate+))
-		(stream-recording-p stream)
-		(stream-drawing-p stream)
-		(stream-output-glyph-buffer stream))))))
+	  (values cursor-x cursor-y baseline line-height
+		  (medium-merged-text-style stream)
+		  (cond ((and wrap-p
+			      (stream-text-margin stream)))
+			(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)
@@ -817,7 +813,9 @@
 	      (declare (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))
+		      (spaces-left (if (zerop escapement-x) 
+				       room-left	;diacritic chars have no width
+				       (floor room-left escapement-x)))
 		      (chars-left (- ,end ,start))
 		      (glyphs-left
 			(if max-glyph (- max-glyph next-glyph) most-positive-fixnum))
@@ -830,7 +828,7 @@
 		   (dotimes (i chars-to-do)
 		     (let* ((char (aref ,string (the fixnum (+ ,start i)))))
 		       ;; Stop when we get to an unusual character (e.g. Newline)
-		       (unless (or (graphic-char-p char) (diacritic-char-p char))
+		       (unless (graphic-char-p char)	;excludes diacritics
 			 (return-from scan-for-newlines-etc))
 		       ;; When a glyph-buffer was supplied, store the glyph index into it
 		       (when max-glyph
@@ -1045,7 +1043,7 @@
 ;;; Input Editor support.  This does STREAM-SCAN-STRING-FOR-WRITING and
 ;;; other stuff, and calls the continuation so the Input Editor can know
 ;;; where its strings are on the screen.
-(defmethod do-text-screen-real-estate ((stream output-protocol-mixin) continuation
+(Defmethod do-text-screen-real-estate ((stream output-protocol-mixin) continuation
 				       string start end
 				       cursor-x cursor-y height baseline style max-x)
   ;; Continuation is a function which takes L T R B Baseline
@@ -1097,5 +1095,7 @@
 				       new-cursor-x (+ cursor-y height vsp) baseline)
 		 (setf cursor-x new-cursor-x)
 		 (incf start)))
+	      ((diacritic-char-p write-char)
+	       (incf start))
 	      (t (error "~S found char ~A, and doesn't know what to do."	; ??
 			'do-text-screen-real-estate write-char)))))))
diff --git a/clim/prefill.lisp b/clim/prefill.lisp
index 921381a4b51ac0827b8320f5559ea91bf481be8d..8dc500ec5ca14cb051d1568c6947b308fb38a99c 100644
--- a/clim/prefill.lisp
+++ b/clim/prefill.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: prefill.lisp,v 1.11 92/10/02 15:19:48 cer Exp $
+;; $fiHeader: prefill.lisp,v 1.12 92/10/28 11:31:53 cer Exp $
 
 (in-package :clim-internals)
 
@@ -3158,8 +3158,6 @@
     (application-pane))
   (window-expose
     (clim-stream-pane))
-  ((setf window-label)
-    (t clim-stream-pane))
   (window-modifier-state
     (command-menu-pane)
     (interactor-pane)
@@ -3615,7 +3613,6 @@
   (window-clear)
   (window-erase-viewport)
   (window-expose)
-  ((setf window-label))
   (window-modifier-state)
   (window-refresh)
   (window-set-inside-size)
diff --git a/clim/present.lisp b/clim/present.lisp
index 82ee5ea061059a5ef5002f6bbe4927a1939c9907..67ace546bc5a0ba827cf143d349b5ea016775469 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.8 92/10/02 15:19:52 cer Exp $
+;; $fiHeader: present.lisp,v 1.9 92/10/28 11:31:57 cer Exp $
 
 (in-package :clim-internals)
 
@@ -91,12 +91,12 @@
 ;; to special-case them all for string streams.  Result is a string
 ;; representation of the output.  STREAM must be an actual window; the
 ;; formatting of the string will match the dimensions of the window.
-(defmacro with-presentations-to-string ((stream &optional string
-					 &rest options
-					 &key (element-type ''character)
-					      (end-of-line-action ':allow)
-					      (end-of-page-action ':allow))
-					&body body)
+(defmacro with-presentations-to-string 
+	  ((stream &optional string
+		   &rest options
+		   &key (element-type #+ANSI-90 ''character #-ANSI-90 ''string-char)
+			(end-of-line-action ':allow) (end-of-page-action ':allow))
+	   &body body)
   (declare (ignore element-type end-of-line-action end-of-page-action))
   (default-output-stream stream with-presentations-to-string)
   `(flet ((with-presentations-to-string-body (,stream) ,@body))
@@ -104,10 +104,10 @@
      (invoke-with-presentations-to-string 
        ,stream #'with-presentations-to-string-body ,string ,@options)))
 
-(defun invoke-with-presentations-to-string (stream continuation string
-					   &key (element-type 'character) 
-						(end-of-line-action ':allow)
-						(end-of-page-action ':allow))
+(defun invoke-with-presentations-to-string 
+       (stream continuation string
+	&key (element-type #+ANSI-90 'character #-ANSI-90 'string-char) 
+	     (end-of-line-action ':allow) (end-of-page-action ':allow))
   (let ((record
 	  (with-end-of-line-action (stream end-of-line-action)
 	    (with-end-of-page-action (stream end-of-page-action)
diff --git a/clim/ptypes1.lisp b/clim/ptypes1.lisp
index 5df5d9da7b6519f5d1e80b21d3bd2635b4e77779..ed89baa036eb217bfb3c27d7517b97e16bc8939f 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.17 92/10/28 08:19:31 cer Exp Locker: cer $
+;; $fiHeader: ptypes1.lisp,v 1.18 92/10/28 11:31:59 cer Exp $
 
 (in-package :clim-internals)
 
@@ -338,32 +338,36 @@
 #+CCL-2
 (defvar *presentation-class-type-table* (make-hash-table))
 
-;;; Find the class corresponding to the presentation type named name
+;;; Find the class corresponding to the presentation type named NAME
 (defun find-presentation-type-class (name &optional (errorp t) environment)
   #+Genera (declare (inline compile-file-environment-p))
   #+Allegro (setq environment (compile-file-environment-p environment))
-  (typecase name
-    (symbol
-      (let ((compile-file-environment-p (compile-file-environment-p environment)))
-	(or (and (eq name (first *presentation-type-being-defined*))
-		 (second *presentation-type-being-defined*))
-	    (if compile-file-environment-p
-		(compile-time-property name 'presentation-type-class)
-		(gethash name *presentation-type-class-table*))
-	    (let ((class (find-class name nil environment)))
-	      (and (acceptable-presentation-type-class class)
-		   class))
-	    (when compile-file-environment-p
-	      ;; compile-file environment inherits from the run-time environment
-	      (or (gethash name *presentation-type-class-table*)
-		  (let ((class (find-class name nil nil)))
-		    (and (acceptable-presentation-type-class class)
-			 class))))
-	    (and errorp (error "~S is not the name of a presentation type" name)))))
-    ((satisfies acceptable-presentation-type-class)
-     name)
-    (otherwise		;a type error should complain even if errorp is nil
-     (error "~S is not the name of a presentation type" name))))
+  (macrolet ((not-found (name)
+	       `(if (gethash name *presentation-type-abbreviation-table*)
+		    (error "~S is a presentation type abbreviation, not the name of a presentation type" ,name)
+		    (error "~S is not the name of a presentation type" ,name))))
+    (typecase name
+      (symbol
+	(let ((compile-file-environment-p (compile-file-environment-p environment)))
+	  (or (and (eq name (first *presentation-type-being-defined*))
+		   (second *presentation-type-being-defined*))
+	      (if compile-file-environment-p
+		  (compile-time-property name 'presentation-type-class)
+		  (gethash name *presentation-type-class-table*))
+	      (let ((class (find-class name nil environment)))
+		(and (acceptable-presentation-type-class class)
+		     class))
+	      (when compile-file-environment-p
+		;; compile-file environment inherits from the run-time environment
+		(or (gethash name *presentation-type-class-table*)
+		    (let ((class (find-class name nil nil)))
+		      (and (acceptable-presentation-type-class class)
+			   class))))
+	      (and errorp (not-found name)))))
+      ((satisfies acceptable-presentation-type-class)
+       name)
+      (otherwise	;a type error should complain even if errorp is nil
+	(not-found name)))))
 
 ;;; Return the presentation type name corresponding to a class
 ;;; This is essentially the inverse of find-presentation-type-class
@@ -1632,7 +1636,7 @@
 
 (define-presentation-generic-function decode-indirect-view-method
                                       decode-indirect-view
-  (type-key parameters options type view frame-manager &key))
+  (type-key parameters options type view frame-manager &key &allow-other-keys))
 
 (define-presentation-generic-function presentation-refined-position-test-method
 				      presentation-refined-position-test
diff --git a/clim/ptypes2.lisp b/clim/ptypes2.lisp
index df64bee717e397be65d17e91a83f7575453b7e8d..beae1b18fa204b5e1f9f4d4a4497a9a8baca05f6 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.15 92/10/28 11:32:03 cer Exp Locker: cer $
+;; $fiHeader: ptypes2.lisp,v 1.16 92/11/05 17:15:39 cer Exp $
 
 (in-package :clim-internals)
 
@@ -488,9 +488,10 @@
   view)
 
 (defun decode-indirect-view (type view frame-manager &rest args &key query-identifier)
+  (declare (dynamic-extent args))
   (declare (ignore query-identifier))
   (apply-presentation-generic-function decode-indirect-view
-     type view frame-manager args))
+    type view frame-manager args))
 
 
 ;;;; Refined position test and highlighting
diff --git a/clim/recording-protocol.lisp b/clim/recording-protocol.lisp
index 52af631ac2cb738a30935b0ea42529fb5a3fb5d5..996f38039cef5c790cd3a12cfba48eeff841b73d 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.24 92/10/28 11:32:05 cer Exp Locker: cer $
+;; $fiHeader: recording-protocol.lisp,v 1.25 92/10/28 13:17:26 cer Exp $
 
 (in-package :clim-internals)
 
@@ -546,6 +546,11 @@
 	  (if new-output-record
 	      (copy-display-state new-output-record nil)
 	      (setq new-output-record
+		    ;; Note that we set the x- and y-positions to 0.  We
+		    ;; do this because setting the cursor position to (x,y)
+		    ;; has the appropriate effect, and setting the other
+		    ;; positions can cause the record to be mis-positioned
+		    ;; if we don't actually do any output into it.
 		    (if constructor
 			(apply constructor
 			       :x-position 0 :y-position 0 initargs)
@@ -553,7 +558,7 @@
 			       :x-position 0 :y-position 0 initargs))))
 	  (output-record-set-start-cursor-position new-output-record x y)
 	  (with-output-record-1 continuation 
-	    stream new-output-record cursor-x cursor-y)
+				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
@@ -574,7 +579,7 @@
 
 (defun with-output-record-1 (continuation stream record abs-x abs-y)
   ;; Close the text record before and after
-  (stream-close-text-output-record (or *original-stream* stream))
+  (stream-close-text-output-record (encapsulated-stream stream))
   (let ((current-output-position
 	  (stream-output-history-position stream)))
     (letf-globally (((point-x current-output-position) abs-x)
@@ -585,8 +590,8 @@
 	  (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 (or *original-stream* stream)))))
+	  record (- end-x abs-x) (- end-y abs-y)))
+      (stream-close-text-output-record (encapsulated-stream stream)))))
 
 (defun invoke-with-room-for-graphics (stream continuation record-type move-cursor 
 				      &key height (first-quadrant t))
@@ -657,6 +662,14 @@
   (declare (ignore stream region x-offset y-offset))
   nil)
 
+(defun change-output-record-ink (record ink)
+  (labels ((change-ink (record)
+	     (if (output-record-p record)
+		 (map-over-output-records #'change-ink record)
+		 (setf (displayed-output-record-ink record) ink))))
+    (declare (dynamic-extent #'change-ink))
+    (change-ink record)))
+
 (defun move-cursor-beyond-output-record (stream record &optional (y-offset 0))
   (multiple-value-bind (xoff yoff)
       (convert-from-relative-to-absolute-coordinates
diff --git a/clim/standard-types.lisp b/clim/standard-types.lisp
index 9a5c3bf3879180bdaffb0c1eeb7f4e456c651736..e9e31d5c3719ec23e8542bec59344db009adfbca 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.16 92/10/02 15:20:01 cer Exp $
+;; $fiHeader: standard-types.lisp,v 1.17 92/10/28 11:32:07 cer Exp $
 
 (in-package :clim-internals)
 
@@ -562,14 +562,22 @@
  	   stream :acceptably acceptably))
 
 (define-presentation-method accept ((type completion) stream (view textual-view) &key)
-  (values
-    (completing-from-suggestions 
-	(stream :partial-completers partial-completers
-		:help-displays-possibilities (<= (length sequence) 10))
-      (flet ((suggest-item (item)
-	       (suggest (funcall name-key item) (funcall value-key item))))
-	(declare (dynamic-extent #'suggest-item))
-	(map nil #'suggest-item sequence)))))
+  (flet ((possibility-printer (possibility type stream)
+	   (declare (ignore 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 
+	  (stream :partial-completers partial-completers
+		  :possibility-printer #'possibility-printer
+		  :help-displays-possibilities (<= (length sequence) 10))
+	(flet ((suggest-item (item)
+		 (suggest (funcall name-key item) (funcall value-key item))))
+	  (declare (dynamic-extent #'suggest-item))
+	  (map nil #'suggest-item sequence))))))
 
 (define-presentation-method accept-present-default ((type completion) stream
 						    (view dialog-view-mixin)
@@ -736,33 +744,38 @@
 	  (if (eql separator #\space)
 	      " "
 	      (make-array 2 :initial-contents (list separator #\space)))))
-    (loop
-      (let ((element
-	      (with-delimiter-gestures (separators)
-		(completing-from-suggestions
-		    (stream :partial-completers partial-completers
-			    :possibility-printer
-			      #'(lambda (object type stream)
-				  (present (list (second object)) type :stream stream))
-			    :help-displays-possibilities (<= (length sequence) 10))
-		  (flet ((suggest-item (item)
-			   (suggest (funcall name-key item)
-				    (funcall value-key item))))
-		    (declare (dynamic-extent #'suggest-item))
-		    (map nil #'suggest-item sequence))))))
-	(push element list))
+    (flet ((possibility-printer (possibility type stream)
+	     (declare (ignore type))
+	     (funcall printer 
+		      (funcall name-key (find (second possibility) sequence 
+					      :key value-key :test test))
+		      stream)))
+      (declare (dynamic-extent #'possibility-printer))
       (loop
-	(multiple-value-bind (more-to-come object)
-	    (accept-comma stream element-type view
-			  :delimiter-character separator
-			  :echo-space echo-space :echo-string-before-blip echo-string)
-	  (ecase more-to-come
-	    ((nil)
-	     (return-from accept
-	       (nreverse list)))
-	    ((t) (return))	;return to outer loop, call completing-from-suggestions again
-	    ((:accepted)
-	     (push object list))))))))
+	(let ((element
+		(with-delimiter-gestures (separators)
+		  (completing-from-suggestions
+		      (stream :partial-completers partial-completers
+			      :possibility-printer #'possibility-printer
+			      :help-displays-possibilities (<= (length sequence) 10))
+		    (flet ((suggest-item (item)
+			     (suggest (funcall name-key item)
+				      (funcall value-key item))))
+		      (declare (dynamic-extent #'suggest-item))
+		      (map nil #'suggest-item sequence))))))
+	  (push element list))
+	(loop
+	  (multiple-value-bind (more-to-come object)
+	      (accept-comma stream element-type view
+			    :delimiter-character separator
+			    :echo-space echo-space :echo-string-before-blip echo-string)
+	    (ecase more-to-come
+	      ((nil)
+	       (return-from accept
+		 (nreverse list)))
+	      ((t) (return))	;return to outer loop, call completing-from-suggestions again
+	      ((:accepted)
+	       (push object list)))))))))
 
 ;;; A handy routine for accepting comma-separated lists in textual views.
 ;;; If the next character is a comma, absorbs it and any following space and returns T.
@@ -1496,7 +1509,8 @@
 		  (return))
 		 ((and (delimiter-gesture-p char) (not desired-delimiter))
 		  (beep stream))
-		 ((not (ordinary-char-p char))
+		 ((not (or (ordinary-char-p char)
+			   (diacritic-char-p char)))
 		  (beep stream))
 		 ((and (zerop (fill-pointer input-buffer))	;ignore leading space
 		       (whitespace-char-p char)))
diff --git a/clim/table-formatting.lisp b/clim/table-formatting.lisp
index df71f125893c8fe443c67c865e3b1b811b00ef79..510fa2f8b949611ba8a39596799a5c07084bb34c 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.13 92/10/02 15:20:04 cer Exp $
+;; $fiHeader: table-formatting.lisp,v 1.14 92/10/28 11:32:09 cer Exp $
 
 (in-package :clim-internals)
 
@@ -110,7 +110,7 @@
 (defmethod map-over-table-elements-helper
 	   (function (record output-record-mixin) type)
   (declare (dynamic-extent function))
-  ;; recurse into this guy
+  ;; Recurse into this guy
   (map-over-table-elements function record type))
 
 (defmethod map-over-table-elements-helper
@@ -159,12 +159,12 @@
 (defmethod tree-recompute-extent-1 ((record output-record-element-mixin))
   (bounding-rectangle* record))
 
-;;; Cells have been positioned manually, probably.
-;;; Also, this should probably be an :around method so that we can 
-;;; drag the circle inside a cell and have the cell get updated automatically.
-;;; Some extra bit will be needed.
-;;; Until we do this, only table formatting really works (and arbitrary dragging
-;;; of things above cells.
+;; Cells have been positioned manually, probably.
+;; Also, this should probably be an :around method so that we can 
+;; drag the circle inside a cell and have the cell get updated automatically.
+;; Some extra bit will be needed.
+;; Until we do this, only table formatting really works (and arbitrary dragging
+;; of things above cells.
 (defmethod tree-recompute-extent-1 ((record standard-cell-output-record))
   (bounding-rectangle* record))
 
@@ -222,7 +222,7 @@
 )
 
 (defun compute-row-table-p (table)
-  ;; find the first thing.
+  ;; Find the first thing
   (flet ((find-row-or-column (row-or-column)
 	   (return-from compute-row-table-p
 	     (values (row-output-record-p row-or-column)))))
@@ -234,7 +234,7 @@
     (cond ((not (eq row-table-p ':unknown))
 	   row-table-p)
 	  (t
-	   (setf row-table-p (compute-row-table-p table))))))
+	   (setq row-table-p (compute-row-table-p table))))))
 
 ;; How can we make compute-output-size work without saving both an ink-rectangle
 ;; and a whitespace rectangle for each output record?
@@ -264,7 +264,7 @@
 	       (assert (cell-output-record-p cell))
 	       (incf cells)))
       (declare (dynamic-extent #'count-rows #'count-cells))
-      ;; calculate nrows & ncells (= ncells per row)
+      ;; Calculate nrows & ncells (= ncells per row)
       (funcall table-mapper #'count-rows table))
     ;; If there are no rows, COUNT-ROWS won't get invoked and NCELLS
     ;; will be NIL.  If all the rows and columns are empty, NCELLS will
@@ -332,7 +332,7 @@
 		     (let ((this-row-height (row-max-height row-count))
 			   (this-column-width (column-max-width column-count)))
 		       (declare (type coordinate this-row-height this-column-width))
-		       ;; all numbers are in (output-record-parent table) coordinates
+		       ;; All numbers are in (output-record-parent table) coordinates
 		       (if row-table-p (setq column-count -1) (setq row-count -1))
 		       (setq total-width x-pos
 			     total-height y-pos)
@@ -382,7 +382,7 @@
 	      (funcall table-mapper #'row-mapper table)))))))
   (tree-recompute-extent table))
 
-;;; Table has already been laid out.
+;; Table has already been laid out.
 (defmethod adjust-multiple-columns ((table standard-table-output-record) stream
 				    &optional n-columns x-spacing)
   (let ((row-count 0))
@@ -537,7 +537,7 @@
   ;; of a slow MAKE-INSTANCE.  If this body was just expanded inline in
   ;; FORMATTING-CELL, it would just work to slip the IF and simply call
   ;; INVOKE-WITH-NEW-OUTPUT-RECORD...  Too bad.
-  (let ((stream (or *original-stream* stream)))
+  (let ((stream (encapsulated-stream stream)))
     (multiple-value-bind (x y) (stream-cursor-position stream)
       (prog1
 	(if (eq record-type 'standard-cell-output-record)
@@ -572,26 +572,27 @@
       (max-width :initarg :max-width)
       (max-height :initarg :max-height)
       (stream-width :initarg :stream-width)
-      (stream-height :initarg :stream-height))
+      (stream-height :initarg :stream-height)
+      (row-wise :initarg :row-wise))
   (:default-initargs :size 25 :n-columns nil :n-rows nil
 		     :max-width nil :max-height nil
-		     :stream-width nil :stream-height nil))
+		     :stream-width nil :stream-height nil
+		     :row-wise t))
 
 (define-output-record-constructor standard-item-list-output-record
 				  (&key x-position y-position x-spacing y-spacing
 					initial-spacing n-columns n-rows
 					max-width max-height stream-width stream-height
-					(size 25))
+					(row-wise t) (size 25))
   :x-position x-position :y-position y-position
   :x-spacing x-spacing :y-spacing y-spacing :initial-spacing initial-spacing
   :n-columns n-columns :n-rows n-rows :max-width max-width :max-height max-height
-  :stream-width stream-width :stream-height stream-height :size size)
+  :stream-width stream-width :stream-height stream-height :row-wise row-wise :size size)
 
 (defmethod children-never-overlap-p ((record standard-item-list-output-record)) t)
 
-;;; map-over-TABLE-cells??
-#+Genera (zwei:defindentation (map-over-menu-cells 1 1))
-(defmethod map-over-menu-cells ((menu standard-item-list-output-record) function)
+#+Genera (zwei:defindentation (map-over-item-list-cells 1 1))
+(defmethod map-over-item-list-cells ((menu standard-item-list-output-record) function)
   (declare (dynamic-extent function))
   (map-over-table-elements function menu 'cell))
 
@@ -610,8 +611,9 @@
 	(x-spacing (slot-value menu 'x-spacing))
 	(y-spacing (slot-value menu 'y-spacing))
 	(initial-spacing (slot-value menu 'initial-spacing))
-	(max-width (slot-value menu 'max-width))	;don't make menu
-	(max-height (slot-value menu 'max-height))	;exceed these bounds
+	(max-width (slot-value menu 'max-width))	;don't make the menu
+	(max-height (slot-value menu 'max-height))	; exceed these bounds
+	(row-wise (slot-value menu 'row-wise))
 	(constrain t)
 	(preferred-geometry 'column)		;vertical menu
 	(golden-ratio 1.6))
@@ -624,29 +626,27 @@
 	       (maxf max-cell-height height)
 	       (incf ncells))))
       (declare (dynamic-extent #'count-cells))
-      (map-over-menu-cells menu #'count-cells))
+      (map-over-item-list-cells menu #'count-cells))
     ;;--- Perhaps we should check that NCELLS is not zero?
     ;;--- PREFERRED-GEOMETRY isn't used yet
     ;; What's the preferred orientation of the menu?
     (unless (or nrows ncolumns)
-      ;; anything explicit overrides
-      (when constrain				;orientation like window orientation.
+      ;; Anything explicit overrides
+      (when constrain				;orientation like window orientation
 	(let ((swidth (slot-value menu 'stream-width))
 	      (sheight (slot-value menu 'stream-height)))
 	  (when (and swidth sheight)
 	    (when (> (/ swidth sheight) golden-ratio)
-	      ;; when the stream is wider than it is high by more than the golden
+	      ;; When the stream is wider than it is high by more than the golden
 	      ;; ratio, make the preferred ordering 'row
 	      (setq preferred-geometry 'row))))))
-    ;; compute geometry
+    ;; Compute geometry
     (cond (ncolumns
-	   (setq nrows (max 1 (ceiling (/ ncells ncolumns))))
-	   ;;
-	   )
+	   (setq nrows (max 1 (ceiling (/ ncells ncolumns)))))
 	  (nrows
 	   (setq ncolumns (max 1 (ceiling (/ ncells nrows)))))
 	  (max-height
-	   ;; could compute this better
+	   ;; Could compute this better
 	   (setq nrows 
 		 (max 1
 		      (let ((acc-height (coordinate 0))
@@ -668,7 +668,7 @@
 					     (when (> acc-width max-width)
 					       (return-from try-one-row nil))))
 				      (declare (dynamic-extent #'sum-width))
-				      (map-over-menu-cells menu #'sum-width))
+				      (map-over-item-list-cells menu #'sum-width))
 				    (max ncells 1)))
 				;; Won't fit in one row, use a more conservative computation
 				;; that uses max-cell-width instead of the actual widths
@@ -682,8 +682,8 @@
 					   (incf count))))))
 	     (setq nrows (max 1 (ceiling (/ ncells ncolumns))))))
 	  (t
-	   ;; try to make this a golden-ratio menu
-	   ;; deduce golden ratio from other parameters
+	   ;; Try to make this a golden-ratio menu
+	   ;; Deduce golden ratio from other parameters
 	   (setq ncolumns (max 1 (floor (sqrt (/ (* ncells
 						    max-cell-width
 						    max-cell-height)
@@ -712,9 +712,9 @@
 		     (incf column-count)
 		     (when (= column-count ncolumns)
 		       (incf row-count)
-		       (setf column-count 0))))
+		       (setq column-count 0))))
 	      (declare (dynamic-extent #'size-cells))
-	      (map-over-menu-cells menu #'size-cells))
+	      (map-over-item-list-cells menu #'size-cells))
 	    ;; Now default the x-spacing to a spacing that spreads the
 	    ;; columns evenly over the entire width of the menu
 	    (unless x-spacing
@@ -770,21 +770,32 @@
 			       cell
 			       (+ x-offset left-margin accumulated-width x-alignment-adjust)
 			       (+ y-offset top-margin accumulated-height y-alignment-adjust))))
-			 (incf accumulated-width (column-width column-count))
-			 (incf accumulated-width x-spacing)
-			 (incf column-count)
-			 (when (= column-count ncolumns)
-			   (setf accumulated-width 
-				 (if (or (stream-redisplaying-p stream) 
-					 (not initial-spacing))
-				     (coordinate 0)
-				     (coordinate x-spacing)))
-			   (incf accumulated-height (row-height row-count))
-			   (incf accumulated-height y-spacing)
-			   (setf column-count 0)
-			   (incf row-count))))
+			 (cond (row-wise
+				(incf accumulated-width (column-width column-count))
+				(incf accumulated-width x-spacing)
+				(incf column-count)
+				(when (= column-count ncolumns)
+				  (setq accumulated-width 
+					(if (or (stream-redisplaying-p stream) 
+						(not initial-spacing))
+					    (coordinate 0)
+					    (coordinate x-spacing)))
+				  (incf accumulated-height (row-height row-count))
+				  (incf accumulated-height y-spacing)
+				  (setq column-count 0)
+				  (incf row-count)))
+			       (t
+				(incf accumulated-height (row-height row-count))
+				(incf accumulated-height y-spacing)
+				(incf row-count)
+				(when (= row-count nrows)
+				  (setq accumulated-height 0)
+				  (incf accumulated-width (column-width column-count))
+				  (incf accumulated-width x-spacing)
+				  (setq row-count 0)
+				  (incf column-count))))))
 		  (declare (dynamic-extent #'adjust-cells))
-		  (map-over-menu-cells menu #'adjust-cells)))))))))
+		  (map-over-item-list-cells menu #'adjust-cells)))))))))
   (tree-recompute-extent menu))
 
 ;; FORMATTING-ITEM-LIST macro in FORMATTED-OUTPUT-DEFS
@@ -792,7 +803,7 @@
 				    &key x-spacing y-spacing initial-spacing
 					 n-columns n-rows 
 					 max-width max-height stream-width stream-height
-					 (move-cursor T) 
+					 (row-wise t) (move-cursor t) 
 					 (record-type 'standard-item-list-output-record))
   (let ((menu 
 	  (with-output-recording-options (stream :draw nil :record t)
@@ -812,7 +823,8 @@
 								    'formatting-item-list
 								    ':y-spacing)
 					       (stream-vertical-spacing stream))
-					 :initial-spacing initial-spacing)
+					 :initial-spacing initial-spacing
+					 :row-wise row-wise)
 		  (funcall continuation stream)))))))
     (adjust-table-cells menu stream)
     (replay menu stream)
@@ -821,7 +833,7 @@
     menu))
 
 (defun format-items (items &key (stream *standard-output*) printer presentation-type
-				x-spacing y-spacing initial-spacing
+				x-spacing y-spacing initial-spacing (row-wise t)
 				n-rows n-columns max-width max-height
 				(record-type 'standard-item-list-output-record)
 				(cell-align-x ':left) (cell-align-y ':top))
@@ -833,7 +845,8 @@
 				:n-rows n-rows :n-columns n-columns
 				:max-width max-width :max-height max-height
 				:x-spacing x-spacing :y-spacing y-spacing
-				:initial-spacing initial-spacing)
+				:initial-spacing initial-spacing
+				:row-wise row-wise)
     (flet ((format-item (item)
 	     (formatting-cell (stream :align-x cell-align-x :align-y cell-align-y)
 	       (cond (printer
diff --git a/clim/text-formatting.lisp b/clim/text-formatting.lisp
index 8d786ce7141bd10659fc7153fa7a01d936a86eb6..d45f75230520fb5347ea1251b5ab8db5e67eaa8b 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.9 92/07/01 15:47:05 cer Exp $
+;; $fiHeader: text-formatting.lisp,v 1.10 92/09/08 15:18:37 cer Exp $
 
 (in-package :clim-internals)
 
@@ -158,7 +158,7 @@
     (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)))
+    (let ((*original-stream* (encapsulated-stream filling-stream)))
       (apply continuation stream continuation-args))))
 
 (defmethod invoke-with-text-style ((filling-stream filling-stream)
@@ -184,10 +184,11 @@
 			     #'stream-close-text-output-record wrapped))
 
 (defresource filling-stream (stream fill-width break-characters prefix prefix-width)
-  :constructor (make-instance 'filling-stream
-		 :buffer (make-array 100 :element-type 'character
-					 :fill-pointer 0
-					 :adjustable t))
+  :constructor 
+    (make-instance 'filling-stream
+      :buffer (make-array 100 :element-type #+ANSI-90 'character #-ANSI-90 'string-char
+			  :fill-pointer 0
+			  :adjustable t))
   :matcher 't
   :initializer
     (progn
diff --git a/clim/text-recording.lisp b/clim/text-recording.lisp
index 833e5d83ced1e805e7672610650d6f583f69e5e8..130184df5d58c8047e83462e5190485c96c9f997 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.13 92/09/24 09:39:28 cer Exp $
+;; $fiHeader: text-recording.lisp,v 1.14 92/10/02 15:20:06 cer Exp $
 
 (in-package :clim-internals)
 
@@ -32,7 +32,7 @@
     ((string :initarg :string
 	     :reader text-displayed-output-record-string)
      (wrapped-p :initform nil :initarg :wrapped-p)
-     (ink :initarg :ink)
+     (ink :initarg :ink :accessor displayed-output-record-ink)
      (clipping-region :initarg :clipping-region)))
 
 (defclass styled-text-output-record
@@ -42,16 +42,15 @@
      (current-text-style :initform nil :initarg :current-style)
      (baseline :initform (coordinate 0) :initarg :baseline)))
 
-(define-constructor make-standard-text-output-record
-		    standard-text-output-record (string ink clipping-region)
-		    :ink ink :string string :clipping-region clipping-region)
+(define-constructor make-standard-text-output-record standard-text-output-record
+		    (string ink clipping-region)
+  :ink ink :string string :clipping-region clipping-region)
 
-(define-constructor make-styled-text-output-record
-		    styled-text-output-record (string ink clipping-region)
-		    :ink ink :string string :clipping-region clipping-region)
+(define-constructor make-styled-text-output-record styled-text-output-record
+		    (string ink clipping-region)
+  :ink ink :string string :clipping-region clipping-region)
 
-(define-constructor make-styled-text-output-record-1
-		    styled-text-output-record 
+(define-constructor make-styled-text-output-record-1 styled-text-output-record 
 		    (string ink clipping-region wrapped-p style baseline)
   :ink ink :string string :clipping-region clipping-region :wrapped-p wrapped-p
   :initial-style style :current-style style :baseline baseline)
@@ -116,8 +115,12 @@
 			  :align-y :top)
 	      (setf cursor-x new-cursor-x start next-char-index)
 	      (when write-char
-		(cond ((eql write-char #\Tab)	;Only non-lozenged exception char?
+		(cond ((eql write-char #\Tab)
 		       (setf cursor-x (stream-next-tab-column stream cursor-x text-style)))
+		      ((diacritic-char-p write-char)
+		       (draw-text* medium write-char
+				   new-cursor-x (+ cursor-y (- baseline new-baseline))
+				   :align-y :top))
 		      (t 
 		       (multiple-value-bind (new-cursor-x new-cursor-y)
 			   (stream-draw-lozenged-character
@@ -171,8 +174,12 @@
 			  :text-style text-style)
 	      (setf cursor-x new-cursor-x start next-char-index)
 	      (when write-char
-		(cond ((eql write-char #\Tab)	;Only non-lozenged exception char?
+		(cond ((eql write-char #\Tab)
 		       (setf cursor-x (stream-next-tab-column stream cursor-x text-style)))
+		      ((diacritic-char-p write-char)
+		       (draw-text* medium write-char
+				   new-cursor-x (+ cursor-y (- baseline new-baseline))
+				   :align-y :top))
 		      (t 
 		       (multiple-value-bind (new-cursor-x new-cursor-y)
 			   (stream-draw-lozenged-character
@@ -396,7 +403,7 @@
 		   (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 'character
+    (let* ((string (make-array 16 :element-type #+ANSI-90 'character #-ANSI-90 'string-char
 				  :fill-pointer 0 :adjustable t))
 	   (record (if (not (eq style default-style))
 		       (make-styled-text-output-record 
diff --git a/clim/translators.lisp b/clim/translators.lisp
index 6b165e8dcfa3d269dae68a961f156a350e8765d6..77ebb31c7350966ada49de6e7e922eb91b20418c 100644
--- a/clim/translators.lisp
+++ b/clim/translators.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: translators.lisp,v 1.8 92/08/18 17:25:45 cer Exp $
+;; $fiHeader: translators.lisp,v 1.9 92/09/24 09:39:31 cer Exp $
 
 (in-package :clim-internals)
 
@@ -51,6 +51,11 @@
 (defun-inline presentation-translator-p (object)
   (typep object 'presentation-translator))
 
+(defclass presentation-action (presentation-translator) ())
+
+(defun-inline presentation-action-p (object)
+  (typep object 'presentation-action))
+
 (defmethod presentation-translator-command-name ((translator presentation-translator))
   nil)
 
@@ -120,7 +125,8 @@
 	    :pointer-documentation ,pointer-documentation
 	    :menu ,menu
 	    :priority ,priority
-	    :tester-definitive t)
+	    :tester-definitive t
+	    :translator-class presentation-action)
 	   ,arglist
 	 ,@body))))
 
@@ -166,7 +172,7 @@
     (check-type documentation (or string symbol list))
     (check-type pointer-documentation (or string symbol list))
     (check-type menu symbol)
-    (check-type priority (or null integer))
+    (check-type priority (or null (integer 0)))
     (check-type translator-class (or null symbol))
     (let ((defining-forms nil)
 	  (translator-functions nil))
@@ -567,14 +573,15 @@
 	     (when (eq documentation-type :from-body)
 	       ;; In general, it is not safe to run the body of a translator to get
 	       ;; its documentation, but sometimes that's the only way.  Command
-	       ;; menus are one such example.  (Beware of side-effects from actions.)
-	       (catch 'no-translation		;catch simple action errors
-		 (multiple-value-bind (translated-object translated-type)
-		     (call-presentation-translator translator presentation context-type
-						   frame event window x y)
-		   (present translated-object (or translated-type context-type)
-			    :stream stream :view +pointer-documentation-view+)
-		   (return-from document-presentation-translator (values)))))
+	       ;; menus are one such example.
+	       (unless (presentation-action-p translator)
+		 (catch 'no-translation		;just in case...
+		   (multiple-value-bind (translated-object translated-type)
+		       (call-presentation-translator translator presentation context-type
+						     frame event window x y)
+		     (present translated-object (or translated-type context-type)
+			      :stream stream :view +pointer-documentation-view+)
+		     (return-from document-presentation-translator (values))))))
 	     ;; If we didn't get asked to run the body for the purpose of command
 	     ;; menus, then we might be able to take a different kind of short
 	     ;; cut for to-command translators.