diff --git a/contrib/demos/demos.catalog b/contrib/demos/demos.catalog
index c38ec9a8fa1633008d4de8c329cb99ba794a279f..38a287a1422e05624fb9c32aa77e6cffa4a57d69 100644
--- a/contrib/demos/demos.catalog
+++ b/contrib/demos/demos.catalog
@@ -2,8 +2,8 @@ Package Name:
    DEMOS
 
 Description:
-   Graphics demonstration programs for CMU Common Lisp using version 11 of the
-X Window System.
+   Graphics demonstration programs for CMU Common Lisp using version 11
+of the X Window System.
 
 Author:
    CMU Common Lisp Group.
@@ -17,22 +17,23 @@ Address:
    Pittsburgh, PA 15213
 
 Net Address:
-   slisp-group@b
+   cmucl-imp@cons.org
 
 Copyright Status:
    Public Domain.
 
 Files:
-   demos.lisp, demos.fasl, demos.catalog.
+   demos.lisp, demos.fasl, demos.catalog.menu.lisp
 
 How to Get:
    The following unix command will copy the pertinent files into directory
 <spec>:
-   cp /afs/cs.cmu.edu/project/slisp/library/demos/* <spec>
+   cp .../library/demos/* <spec>
 
 Portability:
-   Should run in any Common Lisp supporting CLX V11R3.
+   Should run in any Common Lisp supporting CLX V11R4.
 
 Instructions:
-   The function DEMOS:DO-ALL-DEMOS will run through each of the demos once, and
-the function DEMOS:DEMO will present a menu of all the demos.
+   The function DEMOS:DO-ALL-DEMOS will run through each of the demos
+once, and the function DEMOS:DEMO will present a menu of all the
+demos.
diff --git a/contrib/demos/demos.lisp b/contrib/demos/demos.lisp
index 91aa7e7b1067eecf839f5cb2d5203ea2606e24ff..4fad384778d16c7fd91f0677863ce60582bae94c 100644
--- a/contrib/demos/demos.lisp
+++ b/contrib/demos/demos.lisp
@@ -5,11 +5,23 @@
 ;;;
 ;;; This file should be portable to any valid Common Lisp with CLX -- DEC 88.
 ;;;
+;;; CMUCL MP support by Douglas Crosher 1998.
+;;; Enhancements including the CLX menu, rewrite of the greynetic
+;;; demo, and other fixes by Fred Gilham 1998.
+;;;
+;;; To run first compile and load menu.lisp, then after compiling and
+;;; loading this file run (demos:demo) to create a menu of demos.
+;;;
 
-(in-package "DEMOS" :use '("LISP"))
-
-(export '(do-all-demos demo))
+(eval-when (compile load eval)
+  (defpackage "DEMOS"
+      (:use "COMMON-LISP")
+    (:export "DO-ALL-DEMOS" "DEMO" "BOUNCING-BALL-DEMO" "BOUNCE-DEMO"
+	     "FAST-HANOI-DEMO" "GREYNETIC-DEMO" "PETAL-DEMO" "PLAID-DEMO"
+	     "QIX-DEMO" "RECURRENCE-DEMO" "SHOVE-BOUNCE-DEMO"
+	     "SLOW-HANOI-DEMO")))
 
+(in-package "DEMOS")
 
 
 ;;;; Graphic demos wrapper macro.
@@ -29,50 +41,71 @@
 (defvar *white-pixel* nil)
 (defvar *window* nil)
 
+;;; Machine-dependent; should calibrate this on the fly.
+;;; Set it to zero to have the demos go too fast.
+(defvar *delay* .01)
+
+(defun wait-for-mapping (display win)
+  (xlib:display-finish-output display)
+  (multiple-value-bind (width height x y mapped) (full-window-state win)
+    (declare (ignore width height x y))
+    (if (eq mapped :viewable)
+	t
+	(wait-for-mapping display win))))
+
+(defun wait-for-unmapping (display win)
+  (xlib:display-finish-output display)
+  (multiple-value-bind (width height x y mapped) (full-window-state win)
+    (declare (ignore width height x y))
+    (if (eq mapped :unmapped)
+	t
+	(wait-for-unmapping display win))))
+
 (defmacro defdemo (fun-name demo-name args x y width height doc &rest forms)
   `(progn
      (defun ,fun-name ,args
        ,doc
-       (cond (*display*
-	      (xlib:with-state (*window*)
-		(setf (xlib:drawable-x *window*) ,x)
-		(setf (xlib:drawable-y *window*) ,y)
-		(setf (xlib:drawable-width *window*) ,width)
-		(setf (xlib:drawable-height *window*) ,height)))
-	     (t
-	      #+:cmu
-	      (multiple-value-setq (*display* *screen*) (ext:open-clx-display))
-	      #-:cmu
-	      (progn
-		;; Portable method
-		(setf *display* (xlib:open-display (machine-instance)))
-		(setf *screen* (xlib:display-default-screen *display*)))
-	      (setf *root* (xlib:screen-root *screen*))
-	      (setf *black-pixel* (xlib:screen-black-pixel *screen*))
-	      (setf *white-pixel* (xlib:screen-white-pixel *screen*))
-	      (setf *window* (xlib:create-window :parent *root*
-						 :x ,x :y ,y
-						 :event-mask nil
-						 :width ,width :height ,height
-						 :background *white-pixel*
-						 :border *black-pixel*
-						 :border-width 2
-						 :override-redirect :on))))
-       (xlib:map-window *window*)
-       ;; 
-       ;; I hate to do this since this is not something any normal
-       ;; program should do ...
-       (setf (xlib:window-priority *window*) :above)
-       (xlib:display-finish-output *display*)
-       (unwind-protect
-	   (progn ,@forms)
-	 (xlib:unmap-window *window*)
-	 (xlib:display-finish-output *display*)))
-     (setf (get ',fun-name 'demo-name) ',demo-name)
-     (setf (get ',fun-name 'demo-doc) ',doc)
-     (export ',fun-name)
-     (pushnew ',fun-name *demos*)
-     ',fun-name))
+       (unless *display*
+	 #+:cmu
+	 (multiple-value-setq (*display* *screen*) (ext:open-clx-display))
+	 #-:cmu
+	 (progn
+	   ;; Portable method
+	   (setf *display* (xlib:open-display (machine-instance)))
+	   (setf *screen* (xlib:display-default-screen *display*)))
+	 (setf *root* (xlib:screen-root *screen*))
+	 (setf *black-pixel* (xlib:screen-black-pixel *screen*))
+	 (setf *white-pixel* (xlib:screen-white-pixel *screen*)))
+       (let ((*window* (xlib:create-window :parent *root*
+					   :x ,x :y ,y
+					   :event-mask '(:visibility-change)
+					   :width ,width :height ,height
+					   :background *black-pixel*
+					   :border *white-pixel*
+					   :border-width 2
+					   ;:override-redirect :on
+					   )))
+	 (xlib:set-wm-properties *window*
+				 :name ,demo-name
+				 :icon-name ,demo-name
+				 :resource-name ,demo-name
+				 :x ,x :y ,y :width ,width :height ,height
+				 :user-specified-position-p t
+				 :user-specified-size-p t
+				 :min-width ,width :min-height ,height
+				 :width-inc nil :height-inc nil)
+	 (xlib:map-window *window*)
+	 ;; Wait until we get mapped before doing anything.
+	 (wait-for-mapping *display* *window*) 
+	 (unwind-protect
+	      (progn ,@forms)
+	   (xlib:unmap-window *window*)
+	   (wait-for-unmapping *display* *window*))))
+    (setf (get ',fun-name 'demo-name) ',demo-name)
+    (setf (get ',fun-name 'demo-doc) ',doc)
+    (export ',fun-name)
+    (pushnew ',fun-name *demos*)
+    ',fun-name))
 
 
 ;;;; Main entry points.
@@ -82,50 +115,78 @@
     (funcall demo)
     (sleep 3)))
 
-;;; DEMO is a hack to get by.  It should be based on creating a menu.  At
-;;; that time, *name-to-function* should be deleted, since this mapping will
-;;; be manifested in the menu slot name cross its action.  Also the
-;;; "Shove-bounce" demo should be renamed to "Shove bounce"; likewise for
-;;; "Fast-towers-of-Hanoi" and "Slow-towers-of-hanoi".
-;;;
+;;; DEMO
 
 (defvar *name-to-function* (make-hash-table :test #'eq))
 (defvar *keyword-package* (find-package "KEYWORD"))
+(defvar *demo-names* nil)
 
-(defun demo ()
-  (macrolet ((read-demo ()
-	       `(let ((*package* *keyword-package*))
-		  (read))))
+(defun demo-chooser ()
+  (let ((*demo-names* '("Quit")))
     (dolist (d *demos*)
       (setf (gethash (intern (string-upcase (get d 'demo-name))
 			     *keyword-package*)
 		     *name-to-function*)
-	    d))
-    (loop
-      (fresh-line)
-      (dolist (d *demos*)
-	(write-string "   ")
-	(write-line (get d 'demo-name)))
-      (write-string "   ")
-      (write-line "Help <demo name>")
-      (write-string "   ")
-      (write-line "Quit")
-      (write-string "Enter demo name: ")
-      (let ((demo (read-demo)))
-	(case demo
-	  (:help
-	   (let* ((demo (read-demo))
-		  (fun (gethash demo *name-to-function*)))
-	     (fresh-line)
-	     (if fun
-		 (format t "~&~%~A~&~%" (get fun 'demo-doc))
-		 (format t "Unknown demo name -- ~A." demo))))
-	  (:quit (return t))
-	  (t
-	   (let ((fun (gethash demo *name-to-function*)))
-	     (if fun
-		 (funcall fun)
-		 (format t "~&~%Unknown demo name -- ~A.~&~%" demo)))))))))
+	    d)
+      (push (get d 'demo-name) *demo-names*))
+  
+    (multiple-value-bind (display screen) (ext:open-clx-display)
+      (let* ((fg-color (xlib:screen-white-pixel screen))
+	     (bg-color (xlib:screen-black-pixel screen))
+	     (nice-font (xlib:open-font display "fixed")))
+	
+	(let ((a-menu (xlib::create-menu
+		       (xlib::screen-root screen) ;the menu's parent
+		       fg-color bg-color nice-font)))
+	  
+	  (setf (xlib::menu-title a-menu) "Please pick your favorite demo:")
+	  (xlib::menu-set-item-list a-menu *demo-names*)
+	  (unwind-protect
+	       (do (choice)
+		   ((and (setf choice (xlib::menu-choose a-menu 100 100))
+			 (string-equal "Quit" choice)))
+		 (let* ((demo-choice (intern (string-upcase choice)
+					     *keyword-package*))
+			(fun (gethash demo-choice *name-to-function*)))
+		   (setf choice nil)
+		   (when fun
+		     #-mp (funcall fun)
+		     #+mp (mp:make-process #'(lambda ()
+					       (funcall fun))
+					   :name (format nil "~S"
+							 demo-choice)))))
+	    (xlib::close-display display)))))))
+
+#-mp
+(defun demo ()
+  (demo-chooser))
+
+;;; Example of how the multi-process support can be setup for use
+;;; with CLX.
+#+mp
+(defun demo ()
+  ;; Set the event server timeout so that an interactive process
+  ;; can act as the idle loop.
+  (setf lisp::*max-event-to-sec* 0)
+  (setf lisp::*max-event-to-usec* 10000)
+  ;;
+  ;; Start a background SIGALRM driven process-yield. This is
+  ;; currently not safe in CMUCL but almost works.
+  ;(mp::start-sigalrm-yield 0 250000)
+  ;;
+  ;; Setup the initial process as the idle process.
+  (setf mp::*idle-process* mp::*initial-process*)
+  ;;
+  ;; Startup a process to run the menu.
+  (mp:make-process #'demo-chooser :name "Demos Menu")
+  ;; Can start multiple demo menus.
+  (mp:make-process #'demo-chooser :name "Demos Menu")
+  ;;
+  ;; Optionally start the idle-process-loop which will better time any
+  ;; process sleeping.
+  (setf mp::*idle-loop-timeout* 0.010d0)
+  (mp::idle-process-loop))
+
 
 
 ;;;; Shared demo utilities.
@@ -139,58 +200,125 @@
 
 ;;;; Greynetic.
 
-;;; GREYNETIC displays random sized and shaded boxes in a window.  This is
-;;; real slow.  It needs work.
-;;; 
-(defun greynetic (window duration)
-  (let* ((pixmap (xlib:create-pixmap :width 32 :height 32 :depth 1
-				     :drawable window))
-	 (gcontext (xlib:create-gcontext :drawable window
-					 :background *white-pixel*
-					 :foreground *black-pixel*
-					 :tile pixmap
-					 :fill-style :tiled)))
-    (multiple-value-bind (width height) (full-window-state window)
-      (dotimes (i duration)
-	(let* ((pixmap-data (greynetic-pixmapper))
-	       (image (xlib:create-image :width 32 :height 32
-					 :depth 1 :data pixmap-data)))
-	  (xlib:put-image pixmap gcontext image :x 0 :y 0 :width 32 :height 32)
-	  (xlib:draw-rectangle window gcontext
-			       (- (random width) 5)
-			       (- (random height) 5)
-			       (+ 4 (random (truncate width 3)))
-			       (+ 4 (random (truncate height 3)))
-			       t))
-	(xlib:display-force-output *display*)))
-    (xlib:free-gcontext gcontext)
-    (xlib:free-pixmap pixmap)))
-
-(defvar *greynetic-pixmap-array*
-  (make-array '(32 32) :initial-element 0 :element-type 'xlib:pixel))
-
-(defun greynetic-pixmapper ()
-  (let ((pixmap-data *greynetic-pixmap-array*))
+(defun make-random-bitmap ()
+  (let ((bitmap-data (make-array '(32 32) :initial-element 0
+				 :element-type 'xlib::bit)))
     (dotimes (i 4)
       (declare (fixnum i))
       (let ((nibble (random 16)))
-	(setf nibble (logior nibble (ash nibble 4))
-	      nibble (logior nibble (ash nibble 8))
-	      nibble (logior nibble (ash nibble 12))
-	      nibble (logior nibble (ash nibble 16)))
-	(dotimes (j 32)
-	  (let ((bit (if (logbitp j nibble) 1 0)))
-	    (setf (aref pixmap-data i j) bit
-		  (aref pixmap-data (+ 4 i) j) bit
-		  (aref pixmap-data (+ 8 i) j) bit
-		  (aref pixmap-data (+ 12 i) j) bit
-		  (aref pixmap-data (+ 16 i) j) bit
-		  (aref pixmap-data (+ 20 i) j) bit
-		  (aref pixmap-data (+ 24 i) j) bit
-		  (aref pixmap-data (+ 28 i) j) bit)))))
-    pixmap-data))
-
-(defdemo greynetic-demo "Greynetic" (&optional (duration 300))
+        (setf nibble (logior nibble (ash nibble 4))
+              nibble (logior nibble (ash nibble 8))
+              nibble (logior nibble (ash nibble 12))
+              nibble (logior nibble (ash nibble 16)))
+        (dotimes (j 32)
+          (let ((bit (if (logbitp j nibble) 1 0)))
+            (setf (aref bitmap-data i j) bit
+                  (aref bitmap-data (+ 4 i) j) bit
+                  (aref bitmap-data (+ 8 i) j) bit
+                  (aref bitmap-data (+ 12 i) j) bit
+                  (aref bitmap-data (+ 16 i) j) bit
+                  (aref bitmap-data (+ 20 i) j) bit
+                  (aref bitmap-data (+ 24 i) j) bit
+                  (aref bitmap-data (+ 28 i) j) bit)))))
+    bitmap-data))
+
+
+(defun make-random-pixmap ()
+  (let ((image (xlib:create-image :depth 1 :data (make-random-bitmap))))
+    (make-pixmap image 32 32)))
+
+(defvar *pixmaps* nil)
+
+(defun make-pixmap (image width height)
+  (let* ((pixmap (xlib:create-pixmap :width width :height height
+				     :depth 1 :drawable *root*))
+	 (gc (xlib:create-gcontext :drawable pixmap
+				   :background *black-pixel*
+				   :foreground *white-pixel*)))
+    (xlib:put-image pixmap gc image :x 0 :y 0 :width width :height height)
+    (xlib:free-gcontext gc)
+    pixmap))
+
+
+;;;
+;;; This function returns one of the pixmaps in the *pixmaps* array.
+(defun greynetic-pixmapper ()
+  (aref *pixmaps* (random (length *pixmaps*))))
+
+
+(defun greynetic (window duration)
+  (let* ((depth (xlib:drawable-depth window))
+	 (draw-gcontext (xlib:create-gcontext :drawable window
+					      :foreground *white-pixel*
+					      :background *black-pixel*))
+	 ;; Need a random state per process.
+	 (*random-state* (make-random-state t))
+	 (*pixmaps* (let ((pixmap-array (make-array 30)))
+		      (dotimes (i 30)
+			(setf (aref pixmap-array i) (make-random-pixmap)))
+		      pixmap-array)))
+
+    (unwind-protect
+	(multiple-value-bind (width height) (full-window-state window)
+	  (declare (fixnum width height))
+	  (let ((border-x (truncate width 20))
+		(border-y (truncate height 20)))
+	    (declare (fixnum border-x border-y))
+	    (dotimes (i duration)
+	      (let ((pixmap (greynetic-pixmapper)))
+		(xlib:with-gcontext (draw-gcontext
+				     :foreground (random (ash 1 depth))
+				     :background (random (ash 1 depth))
+				     :stipple pixmap
+				     :fill-style
+				     :opaque-stippled)
+		   (cond ((zerop (mod i 500))
+			  (xlib:clear-area window)
+			  (sleep .1))
+			 (t
+			  (sleep *delay*)))
+		   (if (< (random 3) 2)
+		       (let* ((w (+ border-x
+				    (truncate (* (random (- width
+							    (* 2 border-x)))
+						 (random width)) width)))
+			      (h (+ border-y
+				    (truncate (* (random (- height
+							    (* 2 border-y)))
+						 (random height)) height)))
+			      (x (random (- width w)))
+			      (y (random (- height h))))
+			 (declare (fixnum w h x y))
+			 (if (zerop (random 2))
+			     (xlib:draw-rectangle window draw-gcontext
+						  x y w h t)
+			     (xlib:draw-arc window draw-gcontext
+					    x y w h 0 6.4 t)))
+		       (let ((p1-x (+ border-x
+				      (random (- width (* 2 border-x)))))
+			     (p1-y (+ border-y
+				      (random (- height (* 2 border-y)))))
+			     (p2-x (+ border-x
+				      (random (- width (* 2 border-x)))))
+			     (p2-y (+ border-y
+				      (random (- height (* 2 border-y)))))
+			     (p3-x (+ border-x
+				      (random (- width (* 2 border-x)))))
+			     (p3-y (+ border-y
+				      (random (- height (* 2 border-y))))))
+			 (declare (fixnum p1-x p1-y p2-x p2-y p3-x p3-y))
+			 (xlib:draw-lines window draw-gcontext
+					  (list p1-x p1-y p2-x p2-y p3-x p3-y)
+					  :relative-p nil
+					  :fill-p t
+					  :shape :convex)))
+		   (xlib:display-force-output *display*))))))
+      (dotimes (i (length *pixmaps*))
+	(xlib:free-pixmap (aref *pixmaps* i)))
+      (xlib:free-gcontext draw-gcontext))))
+
+
+(defdemo greynetic-demo "Greynetic" (&optional (duration 3000))
   100 100 600 600
   "Displays random grey rectangles."
   (greynetic *window* duration))
@@ -219,7 +347,9 @@
   "Each length is the number of lines to put in a qix, and that many qix
   (of the correct size) are put up on the screen.  Lets the qix wander around
   the screen for Duration steps."
-  (let ((histories (mapcar #'construct-qix lengths)))
+  (let ((histories (mapcar #'construct-qix lengths))
+	(depth (xlib:drawable-depth window))
+	(*random-state* (make-random-state t)))
     (multiple-value-bind (width height) (full-window-state window)
       (declare (fixnum width height))
       (xlib:clear-area window)
@@ -230,20 +360,21 @@
 	(do ((x (qix-buffer (car h)) (cdr x))
 	     (i 0 (1+ i)))
 	    ((= i (car l)))
-	  (rplaca x (make-array 4))))
+	  (rplaca x (make-array 5))))
       ;; Start each qix at a random spot on the screen.
       (dolist (h histories)
 	(let ((x (random width))
 	      (y (random height)))
 	  (rplaca (qix-buffer h)
-		  (make-array 4 :initial-contents (list x y x y)))))
+		  (make-array 5 :initial-contents (list x y x y -1)))))
       (rplacd (last histories) histories)
-      (let (x1 y1 x2 y2 dx1 dy1 dx2 dy2 tem line next-line qix
-	       (gc (xlib:create-gcontext :drawable window
-					 :foreground *white-pixel*
-					 :background *black-pixel*
-					 :line-width 0 :line-style :solid
-					 :function boole-c2)))
+      (let* ((x1 0) (y1 0) (x2 0) (y2 0)
+	     (dx1 0) (dy1 0) (dx2 0) (dy2 0)
+	     tem line next-line qix
+	     (gc (xlib:create-gcontext :drawable window
+				       :background *black-pixel*
+				       :line-width 0 :line-style :solid
+				       :function boole-xor)))
 	(declare (fixnum x1 y1 x2 y2 dx1 dy1 dx2 dy2))
 	(dotimes (i duration)
 	  ;; Line is the next line in the next qix. Rotate this qix and
@@ -257,6 +388,8 @@
 	  (setf y1 (svref line 1))
 	  (setf x2 (svref line 2))
 	  (setf y2 (svref line 3))
+	  (setf (xlib:gcontext-foreground gc) (svref line 4))
+	  (setf (xlib:gcontext-function gc) boole-xor)
 	  (xlib:draw-line window gc x1 y1 x2 y2)
 	  (setq dx1 (- (+ (qix-dx1 qix) (random 3)) 1))
 	  (setq dy1 (- (+ (qix-dy1 qix) (random 3)) 1))
@@ -283,6 +416,7 @@
 	  (setf (qix-dy1 qix) dy1)
 	  (setf (qix-dx1 qix) dx1)
 	  (when (svref next-line 0)
+	    (setf (xlib:gcontext-foreground gc) (svref next-line 4))
 	    (xlib:draw-line window gc
 			    (svref next-line 0) (svref next-line 1)
 			    (svref next-line 2) (svref next-line 3)))
@@ -290,10 +424,12 @@
 	  (setf (svref next-line 1) (+ y1 dy1))
 	  (setf (svref next-line 2) (+ x2 dx2))
 	  (setf (svref next-line 3) (+ y2 dy2))
+	  (setf (svref next-line 4) (random (ash 1 depth)))
+	  (sleep *delay*)
 	  (xlib:display-force-output *display*))))))
 
 
-(defdemo qix-demo "Qix" (&optional (lengths '(30 30)) (duration 2000))
+(defdemo qix-demo "Qix" (&optional (lengths '(30 30 14 12 7)) (duration 2000))
   0 0 700 700
   "Hypnotic wandering lines."
   (qix *window* lengths duration))
@@ -387,13 +523,15 @@
 ;;;; Petal Parameters and Petal itself
 
 (defparameter continuous t)
-(defparameter styinc 2)
+(defparameter styinc 7)
 (defparameter petinc 1)
 (defparameter scalfac-fac 8192)
 
 (defun petal (petal-window &optional (how-many 10) (style 0) (petal 0))
-  (let ((width 512)
-	(height 512))
+  (let ((width 800)
+	(height 800)
+	(depth (xlib:drawable-depth petal-window))
+	(*random-state* (make-random-state t)))
     (xlib:clear-area petal-window)
     (xlib:display-force-output *display*)
     (let ((veccnt 0)
@@ -415,38 +553,40 @@
 	  (y2 0)
 	  (i 0)
 	  (gc (xlib:create-gcontext :drawable petal-window
-				    :foreground *black-pixel*
-				    :background *white-pixel*
+				    :foreground *white-pixel*
+				    :background *black-pixel*
 				    :line-width 0 :line-style :solid)))
       (loop
-	(when (zerop veccnt)
-	  (setq tt 0 s 0 lststyle style lstpetal petal petal nupetal
-		style nustyle petstyle (rem (* petal style) d360)
-		vectors (complete style petal))
-	  (when continuous
-	    (setq nupetal  (+ nupetal petinc)
-		  nustyle (+ nustyle styinc)))
-	  (when (or (/= lststyle style) (/= lstpetal petal))
-	    (xlib:clear-area petal-window)
-	    (xlib:display-force-output *display*)))
-	(when (or (/= lststyle style) (/= lstpetal petal))
-	  (setq veccnt (1+ veccnt) i veccnt x1 x2 y1 y2
-		tt (rem (+ tt style) d360)
-		s (rem (+ s petstyle) d360)
-		r (pcos s))
-	  (setq x2 (+ ctrx (floor (high-16bits-* (pcos tt) r) scalfac))
-		y2 (+ ctry (floor (high-16bits-* (psin tt) r) scalfac)))
-	  (when (/= i 1)
-	    (xlib:draw-line petal-window gc x1 y1 x2 y2)
-	    (xlib:display-force-output *display*)))
-	(when (> veccnt vectors)
-	  (setq veccnt 0)
-	  (setq how-many (1- how-many))
-	  (sleep 2)
-	  (when (zerop how-many) (return)))))))
+       (when (zerop veccnt)
+	 (setq tt 0 s 0 lststyle style lstpetal petal petal nupetal
+	       style nustyle petstyle (rem (* petal style) d360)
+	       vectors (complete style petal))
+	 (when continuous
+	   (setq nupetal (+ nupetal petinc)
+		 nustyle (+ nustyle styinc)))
+	 (when (or (/= lststyle style) (/= lstpetal petal))
+	   (setf (xlib:gcontext-foreground gc)
+		 (random (ash 1 depth)))
+	   (xlib:clear-area petal-window)
+	   (xlib:display-force-output *display*)))
+       (when (or (/= lststyle style) (/= lstpetal petal))
+	 (setq veccnt (1+ veccnt) i veccnt x1 x2 y1 y2
+	       tt (rem (+ tt style) d360)
+	       s (rem (+ s petstyle) d360)
+	       r (pcos s))
+	 (setq x2 (+ ctrx (floor (high-16bits-* (pcos tt) r) scalfac))
+	       y2 (+ ctry (floor (high-16bits-* (psin tt) r) scalfac)))
+	 (when (/= i 1)
+	   (xlib:draw-line petal-window gc x1 y1 x2 y2)
+	   (xlib:display-force-output *display*)))
+       (when (> veccnt vectors)
+	 (setq veccnt 0)
+	 (setq how-many (1- how-many))
+	 (sleep 2)
+	 (when (zerop how-many) (return)))))))
 
 (defdemo petal-demo "Petal" (&optional (how-many 10) (style 0) (petal 0))
-  100 100 512 512
+  100 100 800 800
   "Flower-like display."
   (petal *window* how-many style petal))
 
@@ -458,8 +598,8 @@
 (defparameter disk-thickness 15 "The thickness of a disk in pixels.")
 (defparameter disk-spacing (+ disk-thickness 3)
   "The amount of vertical space used by a disk on a needle.")
-(defvar *horizontal-velocity* 20 "The speed at which disks slide sideways.")
-(defvar *vertical-velocity* 12 "The speed at which disks move up and down.")
+(defvar *horizontal-velocity* 30 "The speed at which disks slide sideways.")
+(defvar *vertical-velocity* 24 "The speed at which disks move up and down.")
 
 ;;; These variables are bound by the main function.
 
@@ -501,8 +641,9 @@
   `(xlib:draw-rectangle *hanoi-window* *hanoi-gcontext*
 			,x ,y ,width ,height t))
 
-(defmacro update-screen ()
-  `(xlib:display-force-output *display*))
+(defun update-screen ()
+  (xlib:display-force-output *display*)
+  (sleep *delay*))
 
 
 ;;;; Moving disks up and down
@@ -698,18 +839,22 @@
 						   :foreground *white-pixel*
 						   :background *black-pixel*
 						   :fill-style :solid
-						   :function boole-c2)))
+						   :function boole-xor
+						   )))
       (xlib:clear-area *hanoi-window*)
       (xlib:display-force-output *display*)
-      (setf (needle-disk-stack needle-1) ())
-      (setf (needle-disk-stack needle-2) ())
-      (setf (needle-disk-stack needle-3) ())
-      (do ((n n (1- n))
-	   (available-disks available-disks (cdr available-disks)))
-	  ((zerop n))
-	(drop-initial-disk (car available-disks) needle-1))
-      (move-n-disks n needle-1 needle-3 needle-2)
-      t)))
+      (let ((needle-1 (make-needle :position 184))
+	    (needle-2 (make-needle :position 382))
+	    (needle-3 (make-needle :position 584)))
+	(setf (needle-disk-stack needle-1) ())
+	(setf (needle-disk-stack needle-2) ())
+	(setf (needle-disk-stack needle-3) ())
+	(do ((n n (1- n))
+	     (available-disks available-disks (cdr available-disks)))
+	    ((zerop n))
+	  (drop-initial-disk (car available-disks) needle-1))
+	(move-n-disks n needle-1 needle-3 needle-2)
+	t))))
 
 ;;; Change the names of these when the DEMO loop isn't so stupid.
 ;;; 
@@ -829,13 +974,13 @@
 
 (defun recurrence (display window &optional (point-count 10000))
   (let ((gc (xlib:create-gcontext :drawable window
-				  :background *white-pixel*
-				  :foreground *black-pixel*)))
+				  :background *black-pixel*
+				  :foreground *white-pixel*)))
     (multiple-value-bind (width height) (full-window-state window)
       (xlib:clear-area window)
       (draw-ppict window gc point-count 0.0 0.0 (* width 0.5) (* height 0.5))
       (xlib:display-force-output display)
-      (sleep 4))
+      (sleep *delay*))
     (xlib:free-gcontext gc)))
 
 ;;; Draw points.  X assumes points are in the range of width x height,
@@ -880,8 +1025,8 @@
 					:function boole-c2
 					:plane-mask (logxor *white-pixel*
 							    *black-pixel*)
-					:background *white-pixel*
-					:foreground *black-pixel*
+					:background *black-pixel*
+					:foreground *white-pixel*
 					:fill-style :solid))
 	(rectangles (make-array (* 4 num-rectangles)
 				:element-type 'number
@@ -908,6 +1053,7 @@
 	      (decf y-off (ash y-dir 1))
 	      (setf y-dir (- y-dir))))
 	  (xlib:draw-rectangles window gcontext rectangles t)
+	  (sleep *delay*)
 	  (xlib:display-force-output display))))
     (xlib:free-gcontext gcontext)))
 
@@ -923,12 +1069,16 @@
 ;;; Ported to CLX by Blaine Burks
 ;;; 
 
-(defvar *ball-size-x* 38)
+(defvar *ball-size-x* 36)
 (defvar *ball-size-y* 34)
 
-(defmacro xor-ball (pixmap window gcontext x y)
-  `(xlib:copy-area ,pixmap ,gcontext 0 0 *ball-size-x* *ball-size-y*
-		   ,window ,x ,y))
+
+(defun xor-ball (pixmap window gcontext x y)
+  (xlib:copy-plane pixmap gcontext 1
+		  0 0
+		  *ball-size-x* *ball-size-y*
+		  window
+		  x y))
 
 (defconstant bball-gravity 1)
 (defconstant maximum-x-drift 7)
@@ -1014,25 +1164,25 @@
 					   :background *black-pixel*
 					   :function boole-xor
 					   :exposures :off))
-	   (bounce-pixmap (xlib:create-pixmap :width 38 :height 34 :depth 1
+	   (bounce-pixmap (xlib:create-pixmap :width 36 :height 34 :depth 1
 					      :drawable window))
 	   (pixmap-gc (xlib:create-gcontext :drawable bounce-pixmap
 					    :foreground *white-pixel*
 					    :background *black-pixel*)))
       (xlib:put-image bounce-pixmap pixmap-gc (get-bounce-image)
-		      :x 0 :y 0 :width 38 :height 34)
+		      :x 0 :y 0 :width 36 :height 34)
       (xlib:free-gcontext pixmap-gc)
       (dolist (ball balls)
 	(xor-ball bounce-pixmap window gcontext (ball-x ball) (ball-y ball)))
-      (xlib:display-force-output display)
       (dotimes (i duration)
 	(dolist (ball balls)
-	  (bounce-1-ball bounce-pixmap window gcontext ball))
-	(xlib:display-force-output display))
+	  (bounce-1-ball bounce-pixmap window gcontext ball)
+	  (xlib:display-force-output display))
+	(sleep *delay*))
       (xlib:free-pixmap bounce-pixmap)
       (xlib:free-gcontext gcontext))))
 
 (defdemo bouncing-ball-demo "Bouncing-Ball" (&optional (how-many 5) (duration 500))
-  34 34 700 500
+  36 34 700 500
   "Bouncing balls in space."
   (bounce-balls *display*  *window* how-many duration))
diff --git a/contrib/demos/menu.lisp b/contrib/demos/menu.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..f0a467c869f0520ab47fd89aa2343b5769e7e831
--- /dev/null
+++ b/contrib/demos/menu.lisp
@@ -0,0 +1,277 @@
+;;; -*- Mode:Lisp; Syntax: Common-lisp; Package:XLIB; Base:10; Lowercase: Yes -*-
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;;            Copyright (C) 1988 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.  
+;;;
+
+(in-package :xlib)
+
+
+;;;----------------------------------------------------------------------------------+
+;;;                                                                                  |
+;;; These functions demonstrate a simple menu implementation described in            |
+;;; Kimbrough, Kerry, "Windows to the Future", Lisp Pointers, Oct-Nov, 1987.         |
+;;; See functions JUST-SAY-LISP and POP-UP for demonstrations.                       |
+;;;                                                                                  |
+;;;----------------------------------------------------------------------------------+
+
+
+
+(defstruct (menu)
+  "A simple menu of text strings."
+  (title "choose an item:")
+  item-alist					;((item-window item-string))
+  window
+  gcontext
+  width
+  title-width
+  item-width
+  item-height
+  (geometry-changed-p t))			;nil iff unchanged since displayed
+
+
+
+(defun create-menu (parent-window text-color background-color text-font)
+  (make-menu
+   ;; Create menu graphics context
+   :gcontext (CREATE-GCONTEXT :drawable   parent-window
+			      :foreground text-color
+			      :background background-color
+			      :font       text-font)
+   ;; Create menu window
+   :window   (CREATE-WINDOW
+	      :parent       parent-window
+	      :class        :input-output
+	      :x            0			;temporary value
+	      :y            0			;temporary value
+	      :width        16			;temporary value
+	      :height       16			;temporary value		
+	      :border-width 2
+	      :border       text-color
+	      :background   background-color
+	      :save-under   :on
+	      ;; :override-redirect :on		;override window mgr when positioning
+	      :event-mask   (MAKE-EVENT-MASK :leave-window :exposure))))
+
+(defun menu-set-item-list (menu item-strings)
+  ;; Assume the new items will change the menu's width and height
+  (setf (menu-geometry-changed-p menu) t)
+
+  ;; Destroy any existing item windows
+  (dolist (item (menu-item-alist menu))
+    (DESTROY-WINDOW (first item)))
+
+  ;; Add (item-window item-string) elements to item-alist
+  (setf (menu-item-alist menu)
+	(let (alist)
+	  (dolist (item item-strings (nreverse alist))
+	    (push (list (CREATE-WINDOW
+			  :parent     (menu-window menu)
+			  :x          0         ;temporary value
+			  :y          0         ;temporary value
+			  :width      16        ;temporary value
+			  :height     16        ;temporary value
+			  :background (GCONTEXT-BACKGROUND (menu-gcontext menu))
+			  :event-mask (MAKE-EVENT-MASK :enter-window
+						       :leave-window
+						       :button-press
+						       :button-release))
+			item)
+		  alist)))))
+
+(defparameter *menu-item-margin* 4
+  "Minimum number of pixels surrounding menu items.")
+
+
+(defun menu-recompute-geometry (menu)
+  (when (menu-geometry-changed-p menu)
+    (let* ((menu-font   (GCONTEXT-FONT (menu-gcontext menu)))
+	   (title-width (TEXT-EXTENTS menu-font (menu-title menu)))
+	   (item-height (+ (FONT-ASCENT menu-font) (FONT-DESCENT menu-font)))
+	   (item-width  0)
+	   (items       (menu-item-alist menu))
+	   menu-width)
+      
+      ;; Find max item string width
+      (dolist (next-item items)
+	(setf item-width (max item-width 
+			      (TEXT-EXTENTS menu-font (second next-item)))))
+      
+      ;; Compute final menu width, taking margins into account
+      (setf menu-width (max title-width
+			    (+ item-width *menu-item-margin* *menu-item-margin*)))      
+      (let ((window  (menu-window menu))
+	    (delta-y (+ item-height *menu-item-margin*)))
+	
+	;; Update width and height of menu window        
+	(WITH-STATE (window)
+	  (setf (DRAWABLE-WIDTH  window) menu-width
+		(DRAWABLE-HEIGHT window) (+ *menu-item-margin*
+					    (* (1+ (length items))
+					       delta-y))))
+	
+	;; Update width, height, position of item windows
+	(let ((item-left     (round (- menu-width item-width) 2))
+	      (next-item-top delta-y))
+	  (dolist (next-item items)
+	    (let ((window (first next-item)))
+	      (WITH-STATE (window)
+		(setf (DRAWABLE-HEIGHT window) item-height
+		      (DRAWABLE-WIDTH  window) item-width
+		      (DRAWABLE-X      window) item-left
+		      (DRAWABLE-Y      window) next-item-top)))
+	    (incf next-item-top delta-y))))
+      
+      ;; Map all item windows
+      (MAP-SUBWINDOWS (menu-window menu))
+
+      ;; Save item geometry
+      (setf (menu-item-width menu)         item-width
+	    (menu-item-height menu)        item-height
+	    (menu-width menu)              menu-width
+	    (menu-title-width menu)        title-width
+	    (menu-geometry-changed-p menu) nil))))
+
+
+(defun menu-refresh (menu)
+  (xlib:set-wm-properties (menu-window menu)
+			  :name (menu-title menu)
+			  :icon-name (menu-title menu)
+			  :resource-name (menu-title menu))
+  (let* ((gcontext   (menu-gcontext menu))
+        (baseline-y (FONT-ASCENT (GCONTEXT-FONT gcontext))))
+   
+   ;; Show title centered in "reverse-video"
+   (let ((fg (GCONTEXT-BACKGROUND gcontext))
+	 (bg (GCONTEXT-FOREGROUND gcontext)))
+     (WITH-GCONTEXT (gcontext :foreground fg :background bg)
+       (DRAW-IMAGE-GLYPHS
+	 (menu-window menu)
+	 gcontext
+	 (round (- (menu-width menu)
+		   (menu-title-width menu)) 2)	;start x
+	 baseline-y				;start y
+	 (menu-title menu))))
+   
+   ;; Show each menu item (position is relative to item window)
+   (dolist (item (menu-item-alist menu))
+     (DRAW-IMAGE-GLYPHS
+       (first item) gcontext
+       0					;start x
+       baseline-y				;start y
+       (second item)))))
+
+
+(defun menu-choose (menu x y)
+  ;; Display the menu so that first item is at x,y.
+  (menu-present menu x y)
+  
+  (let ((items (menu-item-alist menu))
+	(mw    (menu-window menu))
+	selected-item)
+
+    ;; Event processing loop
+    (do () (selected-item)				
+      (EVENT-CASE ((DRAWABLE-DISPLAY mw) :force-output-p t)
+	(:exposure     (count)
+		       
+	 ;; Discard all but final :exposure then display the menu
+	 (when (zerop count) (menu-refresh menu))
+	 t)
+	
+	(:button-release (event-window)
+	 ;;Select an item
+	 (setf selected-item (second (assoc event-window items)))
+	 t)
+	
+	(:enter-notify (window)
+	 ;;Highlight an item
+	 (let ((position (position window items :key #'first)))
+	   (when position
+	     (menu-highlight-item menu position)))
+	 t)
+	
+	(:leave-notify (window kind)
+	 (if (eql mw window)
+	     ;; Quit if pointer moved out of main menu window
+	     (setf selected-item (when (eq kind :ancestor) :none))
+
+	   ;; Otherwise, unhighlight the item window left
+	   (let ((position (position window items :key #'first)))
+	     (when position
+	       (menu-unhighlight-item menu position))))
+	 t)
+	
+	(otherwise ()
+		   ;;Ignore and discard any other event
+		   t)))
+    
+    ;; Erase the menu
+;;;    (UNMAP-WINDOW mw)
+    
+    ;; Return selected item string, if any
+    (unless (eq selected-item :none) selected-item)))
+
+
+(defun menu-highlight-item (menu position)
+  (let* ((box-margin  (round *menu-item-margin* 2))
+	 (left        (- (round (- (menu-width menu) (menu-item-width menu)) 2)
+			 box-margin))
+	 (top         (- (* (+ *menu-item-margin* (menu-item-height menu))
+			    (1+ position))
+			 box-margin))
+	 (width       (+ (menu-item-width menu) box-margin box-margin))
+	 (height      (+ (menu-item-height menu) box-margin box-margin)))
+    
+    ;; Draw a box in menu window around the given item.
+    (DRAW-RECTANGLE (menu-window menu)
+		    (menu-gcontext menu)
+		    left top
+		    width height)))
+
+(defun menu-unhighlight-item (menu position)
+  ;; Draw a box in the menu background color
+  (let ((gcontext (menu-gcontext menu)))
+    (WITH-GCONTEXT (gcontext :foreground (gcontext-background gcontext))
+      (menu-highlight-item menu position))))
+
+
+(defun menu-present (menu x y)
+  ;; Make sure menu geometry is up-to-date
+  (menu-recompute-geometry menu)
+  
+  ;; Try to center first item at the given location, but
+  ;; make sure menu is completely visible in its parent
+  (let ((menu-window (menu-window menu)))
+;;    (multiple-value-bind (tree parent) (QUERY-TREE menu-window)
+;;      (declare (ignore tree))
+;;      (WITH-STATE (parent)
+;;	(let* ((parent-width  (DRAWABLE-WIDTH parent))
+;;	       (parent-height (DRAWABLE-HEIGHT parent))
+;;	       (menu-height   (+ *menu-item-margin*
+;;				 (* (1+ (length (menu-item-alist menu)))
+;;				    (+ (menu-item-height menu)  *menu-item-margin*))))
+;;	       (menu-x        (max 0 (min (- parent-width (menu-width menu))
+;;					  (- x (round (menu-width menu) 2)))))
+;;	       (menu-y        (max 0 (min (- parent-height menu-height)
+;;					  (- y (round (menu-item-height menu) 2/3)
+;;					     *menu-item-margin*)))))
+;;	  (WITH-STATE (menu-window)
+;;	    (setf (DRAWABLE-X menu-window) menu-x
+;;		  (DRAWABLE-Y menu-window) menu-y)))))
+
+    ;; Make menu visible
+    (MAP-WINDOW menu-window)))
+