diff --git a/demo/bitmap-editor.lisp b/demo/bitmap-editor.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..ae3065612513cdbcf86b7614286491d756966dcc
--- /dev/null
+++ b/demo/bitmap-editor.lisp
@@ -0,0 +1,192 @@
+;; -*- mode: common-lisp; package: clim-demo -*-
+;;
+;;				-[]-
+;; 
+;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
+;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
+;;
+;; The software, data and information contained herein are proprietary
+;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
+;; given in confidence by Franz, Inc. pursuant to a written license
+;; agreement, and may be stored and used only in accordance with the terms
+;; of such license.
+;;
+;; Restricted Rights Legend
+;; ------------------------
+;; Use, duplication, and disclosure of the software, data and information
+;; contained herein by any agency, department or entity of the U.S.
+;; Government are subject to restrictions of Restricted Rights for
+;; Commercial Software developed at private expense as specified in FAR
+;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
+;; applicable.
+;;
+;; $fiHeader$
+
+
+(in-package :clim-demo)
+
+(define-application-frame bitmap-editor ()
+			  ((rows :initarg :rows :initform 8)
+			   (cell-size :initarg :cell-size :initform 10)
+			   (columns :initarg :columns :initform 8)
+			   (array :initarg :array :initform nil)
+			   (current-color :initarg :current-color :initform 0)
+			   (colors :initarg :colors :initform 
+				   (list +background-ink+ +foreground-ink+)))
+  (:panes
+   (palette :accept-values :scroll-bars  :vertical :width :compute :height :compute
+	    :display-function '(accept-values-pane-displayer 
+				:displayer display-palette))
+   (edit-pane :application :scroll-bars  :both :width :compute :height :compute)
+   (pattern-pane :application  :scroll-bars nil :width :compute :height :compute))
+  (:layouts (default (horizontally () palette edit-pane pattern-pane))))
+
+(defun display-palette (frame stream)
+  (with-slots (colors current-color) frame
+    (flet ((display-color (object stream)
+	     (with-room-for-graphics (stream)
+	       (draw-rectangle* stream 0 0 30 10 :ink object))))
+      (setf current-color
+	(position
+	 (accept `((completion ,colors)
+		   :name-key ,#'identity
+		   :printer ,#'display-color)
+		 :view '(clim-internals::radio-box-view :orientation
+			 :vertical :toggle-button-options (:indicator-type nil))
+		 :stream stream
+		 :default (nth current-color colors)
+		 :prompt "Colors")
+	 colors))
+      (terpri stream)
+      (accept-values-command-button (stream)
+	"Add Color"
+	(add-color-to-palette frame))
+      (terpri stream)
+      (accept-values-command-button (stream)
+	"Edit Color"
+	(replace-current-color frame))
+            (terpri stream)
+      (accept-values-command-button (stream)
+	"Delete Color"
+	(delete-current-color frame)))))
+
+(defun replace-current-color (frame)
+  ;;--- Exercise for the read
+  )
+
+(defun delete-current-color (frame)
+  ;;--- Exercise for the reader
+  )
+
+(defun add-color-to-palette (frame)
+  (let ((fr (make-application-frame 'color-chooser)))
+    (run-frame-top-level fr)
+    (with-slots (colors) frame
+      (setq colors (append colors (list (color fr)))))))
+
+
+(define-bitmap-editor-command (com-display-options :menu t)
+    ()
+  (let* ((frame *application-frame*)
+	 (rows (slot-value frame 'rows))
+	 (columns (slot-value frame 'columns))
+	 (cell-size (slot-value frame 'cell-size))
+	 (view '(clim-internals::slider-view :show-value-p t)))
+    (accepting-values (*query-io* :own-window t :label "Editor options")
+	(setq rows (accept '(integer 1 256) 
+			   :view view
+			   :default rows
+			   :prompt "Rows"
+			   :stream *query-io*))
+      (terpri *query-io*)
+      (setq columns (accept '(integer 1 256) 
+			   :view view
+			    :default columns
+			    :prompt "Columns"
+			    :stream *query-io*))
+      (terpri *query-io*)
+      (setq cell-size (accept '(integer 10 100) 
+			   :view view
+			      :default cell-size
+			      :prompt "Cell Size"
+			      :stream *query-io*))
+      (terpri *query-io*))
+    (setf (slot-value frame 'rows) rows
+	  (slot-value frame 'columns) columns
+	  (slot-value frame 'cell-size) cell-size
+	  (slot-value frame 'array)
+	  (adjust-array (slot-value frame 'array) (list rows columns)
+			:initial-element 0))
+    (display-everything frame)))
+    
+(defmethod initialize-instance :after ((frame bitmap-editor) &key)
+  (with-slots (rows columns array) frame
+    (setf array (make-array (list rows columns) :initial-element 0))))
+    
+(defmethod display-grid (frame pane)
+  (with-slots (rows columns cell-size) frame
+    (let ((maxx (* rows (1+ cell-size)))
+	  (maxy (* columns (1+ cell-size))))
+      (dotimes (i (1+ rows))
+	(draw-line* pane 0 (* i (1+ cell-size)) maxx (* i (1+ cell-size))))
+      (dotimes (i (1+ columns))
+	(draw-line* pane (* i (1+ cell-size)) 0 (* i (1+ cell-size)) maxy)))))
+
+(defmethod display-cells (frame pane)
+  (with-slots (rows columns cell-size) frame
+    (dotimes (i rows)
+	(dotimes (j columns)
+	  (display-cell frame pane i j)))))
+
+(define-presentation-type bitmap-editor-cell ())
+
+(define-presentation-method presentation-typep (object (type bitmap-editor-cell))
+  (and (listp object) (= 2 (length object))))
+
+(defun display-cell (frame pane i j)
+  (with-slots (cell-size array colors) frame
+    (let ((x (* j (1+ cell-size)))
+	  (y (* i (1+ cell-size))))
+      (with-output-as-presentation (pane (list i j) 'bitmap-editor-cell)
+	(draw-rectangle* pane (+ x 2) 
+			 (+ y 2)
+			 (+ x (- cell-size 2))
+			 (+ y (- cell-size 2))
+			 :ink (nth  (aref array i j) colors)
+			 :filled t)))))
+
+(defun display-pattern (frame)
+  (let ((stream (get-frame-pane frame 'pattern-pane)))
+    (with-slots (array rows columns colors) frame
+      (window-clear stream)
+      (surrounding-output-with-border (stream)
+	  (draw-rectangle* stream 10 10 (+ 10 rows) (+ 10 columns)
+			   :ink 
+			   (make-pattern array colors))))))
+
+(defmethod run-frame-top-level :before ((frame bitmap-editor))
+  (display-everything frame))
+
+(defun display-everything (frame)
+  (let ((stream (get-frame-pane frame 'edit-pane)))
+    (window-clear stream)
+    (display-grid frame stream)
+    (display-cells frame stream)
+    (display-pattern frame)))
+
+(define-presentation-to-command-translator toggle-cell
+    (bitmap-editor-cell com-toggle-cell bitmap-editor :gesture :select)
+  (presentation object)
+  (list presentation object))
+
+(define-bitmap-editor-command com-toggle-cell
+    ((presentation 'presentation)
+     (cell 'bitmap-editor-cell))
+  (let ((frame *application-frame*))
+    (destructuring-bind (i j) cell
+      (with-slots (array current-color) frame
+	(setf (aref array i j) current-color))
+      (let ((stream (get-frame-pane frame 'edit-pane)))
+	(erase-output-record presentation stream)
+	(display-cell frame stream i j)
+	(display-pattern frame)))))
diff --git a/demo/process-browser.lisp b/demo/process-browser.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..8f4475fedf7f568a6cb4c1611a25b2d56514cf73
--- /dev/null
+++ b/demo/process-browser.lisp
@@ -0,0 +1,197 @@
+;; -*- mode: common-lisp; package: clim-demo -*-
+;;
+;;				-[]-
+;; 
+;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
+;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
+;;
+;; The software, data and information contained herein are proprietary
+;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
+;; given in confidence by Franz, Inc. pursuant to a written license
+;; agreement, and may be stored and used only in accordance with the terms
+;; of such license.
+;;
+;; Restricted Rights Legend
+;; ------------------------
+;; Use, duplication, and disclosure of the software, data and information
+;; contained herein by any agency, department or entity of the U.S.
+;; Government are subject to restrictions of Restricted Rights for
+;; Commercial Software developed at private expense as specified in FAR
+;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
+;; applicable.
+;;
+;; $fiHeader$
+
+
+(in-package :clim-demo)
+
+(define-application-frame process-browser ()
+			  ((timer :accessor process-browser-timer :initform nil)
+			   (delay :initarg :delay :accessor process-browser-delay))
+  (:panes
+   (processes :application
+	      :incremental-redisplay '(t :check-overlapping nil)
+	      :display-function 'display-processes
+	      :width :compute :height :compute))
+  (:layouts
+   (default processes))
+  (:default-initargs :delay 5))
+
+(defmethod read-frame-command :around ((frame process-browser) &key)
+  (with-accessors ((timer process-browser-timer)) frame 
+    (unwind-protect
+	(progn
+	  (install-process-browser-timer frame)
+	  (call-next-method))
+      (when timer (clim-utils::delete-timer timer)))))
+
+(defun install-process-browser-timer (frame)
+  (with-accessors ((timer process-browser-timer)
+		   (delay process-browser-delay)) frame 
+    (when timer (clim-utils::delete-timer timer))
+    (setq timer (clim-internals::make-command-timer frame 'com-update-process-browser nil
+				    delay))))
+
+(define-process-browser-command (com-change-delay-browser :menu t)
+    ()
+  (let ((frame *application-frame*))
+    (with-accessors ((timer process-browser-timer)
+		     (delay process-browser-delay)) frame
+      (accepting-values (*query-io* :own-window t)
+			(setf delay (accept '(integer 1 *) 
+					    :prompt "Enter new delay"
+					    :default delay
+					    :stream *query-io*))
+			(terpri *query-io*)))))
+
+(define-process-browser-command com-update-process-browser
+    ()
+  ;;-- We have to do this because of the asynchronous updates
+  (unhighlight-highlighted-presentation *standard-output*))
+
+(define-process-browser-command (com-refresh-process-browser :menu t)
+    ()
+  (window-clear *standard-output*))
+
+#+:composer-v2.0
+(define-process-browser-command com-inspect-process
+    ((process 'mp::process :gesture :select))
+  (wt::winspect process))
+
+(defun display-processes (frame pane &key &allow-other-keys)
+  (declare (ignore frame))
+  (with-text-size (t :small)
+    (let ((*standard-output* pane))
+      (formatting-table ()
+	  (with-text-face (t :bold)
+	    (updating-output (t :unique-id 'headings)
+		(formatting-row ()
+		    (formatting-cell () (write-string "P"))
+		  (formatting-cell () (write-string "Dis"))
+		  (formatting-cell () (write-string "Sec"))
+		  (formatting-cell () (write-string "dSec"))
+		  (formatting-cell () (write-string "Priority"))
+		  (formatting-cell () (write-string "State"))
+		  (formatting-cell () (write-string "Name,Whostate,Arrest")))))
+	;;-- snarfed from toplevel.cl
+	(let* ((processes mp:*all-processes*)
+	       (processes
+		(sort (mp:without-scheduling ;assure consistent data
+			(mapcar #'(lambda (p)
+				    (let* ((times  (mp::process-times-resumed p))
+					   (dtimes (- times (mp::process-times-resumed-1 p)))
+					   (msec   (mp::process-cpu-msec-used p))
+					   (dmsec  (- msec (mp::process-cpu-msec-used-1 p))))
+				      (prog1 (list* dtimes msec dmsec p)
+					(setf (mp::process-times-resumed-1 p) times
+					      (mp::process-cpu-msec-used-1 p) msec))))
+				processes))
+		      #'>= :key #'caddr)))
+	  (dolist (p processes)
+	    (destructuring-bind (times-resumed msec-used msec-used-d . process) p
+	      (let ((profilep 
+		     (let ((stack-group (mp::process-stack-group process)))
+		       (and stack-group
+			    (mp::profile-stack-group-p stack-group)))))
+		(updating-output (t :unique-id process 
+				    :cache-test #'equal
+				    :cache-value 
+				    (list p
+					  profilep
+					  (mp::process-active-p process)
+					  (mp::process-runnable-p process)
+					  (mp::process-wait-function process)
+					  (mp::process-name process)
+					  (mp::process-whostate process)
+					  (mp::process-arrest-reasons process)))
+		    (formatting-row ()
+			(with-output-as-presentation (t
+						      process
+						      'mp::process
+						      :single-box t)
+			  (updating-output (t :cache-value profilep)
+			      (formatting-cell ()
+				  (princ profilep)))
+			  (updating-output (t :cache-value times-resumed)
+			      (formatting-cell ()
+				  (princ times-resumed)))
+			  (updating-output (t :cache-value msec-used)
+			      (formatting-cell ()
+				  (princ (round msec-used 1000))))
+			  (updating-output (t :cache-value msec-used-d)
+			      (formatting-cell ()
+				  (princ (/ msec-used-d 1000.0))))
+			  (updating-output (t :cache-value (mp::process-priority process))
+			      (formatting-cell ()
+				  (princ (mp::process-priority process))))
+
+			  (let ((state
+				 (cond ((not (mp::process-active-p process)) "inactive")
+				       ((mp::process-runnable-p process) "runnable")
+				       ((mp::process-wait-function process) "waiting ")
+				       (t "   ?    "))))
+			    (updating-output (t :cache-value state :cache-test #'equal)
+				(formatting-cell ()
+				    (princ state))))
+			
+			  (updating-output (t :cache-value
+					      (mp::process-name process)
+					      :cache-test #'equal)
+			      (formatting-cell ()
+				  (with-text-face (t :bold)
+				    (princ (mp::process-name process)))))
+			
+			  (updating-output (t :cache-value (mp::process-whostate process))
+			      (formatting-cell ()
+				  (princ (mp::process-whostate
+					  process))))
+			
+			  (updating-output (t :cache-value (mp::process-arrest-reasons process)
+					      :cache-test #'equal)
+			      (formatting-cell ()
+				  (when (mp::process-arrest-reasons process)
+				    (princ (mp::process-arrest-reasons process))))))))))))))))
+
+(defvar *process-browsers* nil)
+
+(defun do-process-browser (&key (port (find-port)) (force nil))
+  (let* ((framem (find-frame-manager :port port))
+	 (frame 
+	   (let* ((entry (assoc port *process-browsers*))
+		  (frame (cdr entry)))
+	     (when (or force (null frame))
+	       (setq frame (make-application-frame 'process-browser
+						   :frame-manager framem)))
+	     (if entry 
+		 (setf (cdr entry) frame)
+		 (push (cons port frame) *process-browsers*))
+	     frame)))
+    (run-frame-top-level frame)))
+
+(define-demo "Process Browser" do-process-browser)
+
+
+
+
+
+  
diff --git a/tk-silica/xm-dialogs.lisp b/tk-silica/xm-dialogs.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..8ca13f30fbcc3ae529b6ececba3553b4613479b8
--- /dev/null
+++ b/tk-silica/xm-dialogs.lisp
@@ -0,0 +1,269 @@
+;; -*- mode: common-lisp; package: clim-internals -*-
+;;
+;;				-[]-
+;; 
+;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
+;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
+;;
+;; The software, data and information contained herein are proprietary
+;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
+;; given in confidence by Franz, Inc. pursuant to a written license
+;; agreement, and may be stored and used only in accordance with the terms
+;; of such license.
+;;
+;; Restricted Rights Legend
+;; ------------------------
+;; Use, duplication, and disclosure of the software, data and information
+;; contained herein by any agency, department or entity of the U.S.
+;; Government are subject to restrictions of Restricted Rights for
+;; Commercial Software developed at private expense as specified in FAR
+;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
+;; applicable.
+;;
+;; $fiHeader$
+
+
+(in-package :clim-internals)
+
+(defmethod frame-manager-accepting-values-frame-class ((framem xm-silica::motif-frame-manager))
+  'motif-accept-values-own-window)
+
+(define-application-frame motif-accept-values-own-window (accept-values-own-window)
+			  ()
+  (:pane 
+   (with-slots (stream own-window exit-button-stream) *application-frame*
+     (vertically ()
+	 (progn
+	   (setq stream
+	     (make-instance 'accept-values-stream
+			    :stream (setf own-window 
+				      (make-pane 'clim-stream-pane
+						 :initial-cursor-visibility :off))))
+	   own-window)
+       (make-pane 'silica::separator :orientation :horizontal)
+       (setf exit-button-stream
+	 (make-pane 'clim-stream-pane
+		    :initial-cursor-visibility nil)))))
+  (:menu-bar nil)
+  (:top-level (accept-values-top-level))
+  (:command-table accept-values)
+  (:command-definer nil))
+
+;;;---- The rest of what in here is dreaming right now
+;;;---- It would be nice to use more 
+
+;#+ignore
+;(define-application-frame xm-silica::motif-accepting-values-frame (accept-values-own-window)
+;			  ()
+;  (:panes
+;   (control-area :application :scroll-bars nil)
+;   (action-area (make-pane 'xm-silica::motif-form-pane)))
+;  (:menu-bar nil)
+;  (:top-level (accept-values-top-level))
+;  (:command-table accept-values)
+;  (:command-definer nil)
+;  (:layouts
+;   (:default
+;       (let ((frame *application-frame*)
+;	     (view +gadget-dialog-view+))
+;	 (let ((vp
+;		(make-pane 'xm-silica::motif-paned-pane
+;			   :children (list control-area action-area))))
+;	   (let ((labels (frame-manager-exit-box-labels (frame-manager frame) frame view)))
+;	     (with-slots (exit-boxes) frame
+;	       (dolist (exit-box exit-boxes)
+;		 (let* ((value (if (consp exit-box) (car exit-box) exit-box))
+;			(label (or (if (consp exit-box) (second exit-box))
+;				   (second (assoc value labels)))))
+;		   (make-pane 'push-button
+;			      :parent action-area
+;			      :label label
+;			      :client frame :id value
+;			      :activate-callback
+;			      #'handle-exit-box-callback))))
+;	     (setf (slot-value action-area 'xm-silica::fraction-base)
+;	       (1+ (* 2 (length labels))))
+;	     (setf (slot-value action-area 'xm-silica::attachments)
+;	       (let ((i 0))
+;		 (mapcar #'(lambda (label)
+;			     (declare (ignore label))
+;			     (prog1
+;			     `(,i :top-attachment :form
+;				  :bottom-attachment :form
+;				  :left-attachment :position
+;				  :left-position ,(1+ (* 2 i))
+;				  :right-attachment :position
+;				  :right-position ,(+ 2 (* 2 i)))
+;			     (incf i)))
+;			 labels)))
+;	     
+;	     vp))))))
+;
+;
+;
+;
+;(defmethod generate-panes :after ((framem standard-frame-manager) 
+;				  (frame xm-silica::motif-accepting-values-frame))
+;  (setf (slot-value frame 'stream) 
+;    (make-instance 'accept-values-stream
+;		   :stream (setf (slot-value frame 'own-window)
+;			     (get-frame-pane frame 'control-area))))
+;  (setf (slot-value frame 'exit-button-stream) nil))
+;
+;(defmethod display-exit-boxes ((frame xm-silica::motif-accepting-values-frame)
+;			       stream
+;			       (view view))
+;  ;;-- Nothing should have changed
+;  nil)
+;
+;;;; Need to hook up the constraint resources and set the min-max size
+;;;; of the action-pane to be just large enough to contain the buttons.
+;
+;(defmethod accept-values-top-level ((frame xm-silica::motif-accepting-values-frame) &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
+;
+;    (unless own-window (return-from accept-values-top-level (call-next-method)))
+;
+;    (let* ((original-view (stream-default-view stream))
+;	   (return-values nil)
+;	   (initial-query nil)
+;	   exit-button-record
+;	   avv avv-record)
+;      (letf-globally (((stream-default-view stream) 
+;		       (frame-manager-dialog-view (frame-manager frame)))
+;		      ((cursor-state (stream-text-cursor stream)) nil))
+;	(labels ((run-continuation (stream avv-record)
+;		   (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))))
+;		     (unless own-window
+;		       (display-exit-boxes frame stream
+;					   (stream-default-view stream)))))
+;		 (run-avv ()
+;		   (when (and initially-select-query-identifier
+;			      (setq initial-query
+;				    (find-query avv-record 
+;						(car initially-select-query-identifier))))
+;		     (if (cdr initially-select-query-identifier)
+;			 (com-modify-avv-choice initial-query)
+;			 (com-edit-avv-choice initial-query))
+;		     (redisplay avv stream :check-overlapping check-overlapping))
+;		   (loop
+;		     (let ((command
+;			    (let ((command-stream (slot-value stream 'stream)))
+;			      ;; While we're reading commands, restore the view
+;			      ;; to what it was before we started.
+;			      (letf-globally (((stream-default-view command-stream)
+;					       original-view))
+;				(read-frame-command frame :stream command-stream)))))
+;		       (if (and command (not (keyboard-event-p command)))
+;			   (execute-frame-command frame command)
+;			 (beep stream)))
+;		     (with-deferred-gadget-updates
+;		       (when (or resynchronize-every-pass
+;				 (slot-value avv-record 'resynchronize))
+;			 ;; When the user has asked to resynchronize every pass, that
+;			 ;; means we should run the continuation an extra time to see
+;			 ;; that all visible stuff is up to date.  That's all!
+;			 (with-output-recording-options (stream :draw nil)
+;			   (redisplay avv stream :check-overlapping check-overlapping)))
+;		     (setf (slot-value avv-record 'resynchronize) nil)
+;
+;;		     (when exit-button-record
+;; 		       (redisplay exit-button-record exit-button-stream))
+;		     
+;		     (redisplay avv stream :check-overlapping check-overlapping)
+;
+;		     (when (ecase (frame-resizable frame)
+; 			     ((nil) nil)
+; 			     ((t) t)
+; 			     (:grow
+;			       (and own-window
+;				    (multiple-value-bind (width height)
+;					(bounding-rectangle-size
+;					  (stream-output-history own-window))
+;				      (multiple-value-bind (vwidth vheight)
+;					  (bounding-rectangle-size 
+;					    (or (pane-viewport own-window) own-window))
+;					(or (> width vwidth) (> height vheight)))))))
+;		       (size-panes-appropriately)))))
+;		 
+;	       (size-panes-appropriately ()
+;		 (changing-space-requirements ()
+;		     ;; We really want to specify the min/max sizes of
+;		     ;; the exit-button pane
+;		     ;; also
+;;		     (when exit-button-stream
+;;		       (size-frame-from-contents exit-button-stream
+;;						 :size-setter
+;;						 #'(lambda (pane w h)
+;;						     (change-space-requirements 
+;;						      pane 
+;;						      :width w :min-width w :max-width w
+;;						      :height h :min-height h :max-height h))))
+;		   (when own-window
+;		     (size-frame-from-contents own-window
+;					       :width own-window-width
+;					       :height own-window-height
+;					       :right-margin own-window-right-margin
+;					       :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")
+;	    (setq avv
+;		  (updating-output (stream)
+;		    (setq avv-record
+;			  (with-end-of-line-action (stream :allow)
+;			    (with-end-of-page-action (stream :allow)
+;			      (with-new-output-record
+;				  (stream 'accept-values-output-record avv-record)
+;				(run-continuation stream avv-record)))))))
+;	    ;; In own window dialogs the buttons are displayed separately
+;;	    (when (and own-window exit-button-stream)
+;;	      (setq exit-button-record
+;;		    (updating-output (exit-button-stream)
+;;		      (with-end-of-line-action (exit-button-stream :allow)
+;;			(with-end-of-page-action (exit-button-stream :allow)
+;;			  (display-exit-boxes frame exit-button-stream
+;;					      (stream-default-view stream)))))))
+;
+;	    (unwind-protect
+;		(cond (own-window
+;		       (size-panes-appropriately)
+;		       (multiple-value-bind (x y)
+;			   #+++ignore (pointer-position (port-pointer (port own-window)))
+;			   #---ignore (values 100 100)
+;			 (when (and own-window-x-position own-window-y-position)
+;			   (setq x own-window-x-position
+;				 y own-window-y-position))
+;			 (position-sheet-carefully
+;			   (frame-top-level-sheet (pane-frame own-window)) x y))
+;		       (window-expose own-window)
+;		       (with-input-focus (own-window)
+;			 (when exit-button-record
+;			   (replay exit-button-record exit-button-stream))
+;			 (replay avv stream)
+;			 (run-avv)))
+;		      (t
+;		       ;; Ensure that bottom of the AVV is visible.  I think that
+;		       ;; this is OK even if the AVV is bigger than the viewport.
+;		       (move-cursor-beyond-output-record (slot-value stream 'stream) avv)
+;		       (stream-ensure-cursor-visible stream)
+;		       (replay avv stream)
+;		       (run-avv)))
+;	      (deactivate-all-gadgets avv-record)
+;	      (unless own-window
+;		(move-cursor-beyond-output-record (slot-value stream 'stream) avv))))
+;	  (values-list return-values))))))
diff --git a/utils/timers.lisp b/utils/timers.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..ca432ab80f428bd6f7b4230aac7d766e12a706f7
--- /dev/null
+++ b/utils/timers.lisp
@@ -0,0 +1,116 @@
+;; -*- mode: common-lisp; package: clim-utils -*-
+;;
+;;				-[]-
+;; 
+;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
+;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
+;;
+;; The software, data and information contained herein are proprietary
+;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
+;; given in confidence by Franz, Inc. pursuant to a written license
+;; agreement, and may be stored and used only in accordance with the terms
+;; of such license.
+;;
+;; Restricted Rights Legend
+;; ------------------------
+;; Use, duplication, and disclosure of the software, data and information
+;; contained herein by any agency, department or entity of the U.S.
+;; Government are subject to restrictions of Restricted Rights for
+;; Commercial Software developed at private expense as specified in FAR
+;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
+;; applicable.
+;;
+;; $fiHeader$
+
+(in-package :clim-utils)
+
+;;;----  Perhaps this should be elsewhere
+;;; Implementation of timers
+;;; Its lame but its ugly.
+;;; You can:
+;;;   make-instance 'timer
+;;;   queue-timer
+;;;   delete-time
+
+(defclass timer ()
+	  ((delay :initarg :delay :reader timer-delay)
+	   (repeat :initarg :repeat :initform nil :reader timer-repeat)
+	   (function :initarg :function :reader timer-function)
+	   (when :accessor timer-when))
+  )
+
+(defvar *timer-input-queue* (make-queue))
+
+(defun add-timer (timer)
+  (ensure-timer-process)
+  (setf (timer-when timer) 
+    (+ (get-internal-real-time) 
+       (* internal-time-units-per-second
+	  (timer-delay timer))))
+  (queue-put *timer-input-queue* timer))
+
+(defun delete-timer (timer)
+  (queue-put *timer-input-queue* `(:delete ,timer)))
+
+(defvar *timers* nil)
+
+(defvar *timer-process* nil)
+
+(defun queue-process-function ()
+  (unwind-protect
+      (progn
+	(setq *timer-process* (Current-process))
+	(flet ((add-timer-to-queue (timer)
+		 (setq *timers* (merge 'list (list timer)  *timers* '< :key #'timer-when))))
+	  (declare (dynamic-extent #'add-timer-to-queue))
+	  (loop
+	    (let ((head (car *timers*)))
+	
+	      (if head
+		  (let* ((time-now (get-internal-real-time))
+			 (time-to-wait (- (timer-when head) time-now)))
+		    (process-wait-with-timeout
+		     "Waiting"
+		     (float (/ time-to-wait internal-time-units-per-second))
+		     #'(lambda () (not (queue-empty-p *timer-input-queue*)))))
+		(process-wait
+		 "Waiting"
+		 #'(lambda () (not (queue-empty-p *timer-input-queue*)))))
+
+      
+	      (loop
+		(let ((head (queue-pop *timer-input-queue*)))
+		  (etypecase head
+		    (null (return nil))
+		    (timer (add-timer-to-queue head))
+		    (cons
+		     (ecase (first head)
+		       (:delete (setf *timers* (delete (second head) *timers*))))))))
+
+	      (loop
+		(unless *timers* (return nil))
+		(let ((time-now (get-internal-real-time))
+		      (timer (car *timers*)))
+		  (if (< (timer-when timer) time-now)
+		      (progn
+			(pop *timers*)
+			(funcall (timer-function timer) timer)
+			(when (timer-repeat timer)
+			  (setf (timer-when timer) 
+			    (+ (get-internal-real-time) 
+			       (* internal-time-units-per-second
+				  (timer-repeat timer))))
+			  (add-timer-to-queue timer)))
+		    (return nil))))))))
+    (setq *timer-process* nil)))
+
+(defun ensure-timer-process ()
+  (unless *timer-process*
+    (make-process #'queue-process-function :name "Timer")))
+
+
+
+
+
+
+