From 0df44936f7edb711d2c9c302008593db133f5af4 Mon Sep 17 00:00:00 2001
From: colin <colin>
Date: Fri, 17 Sep 1993 00:21:30 +0000
Subject: [PATCH] see changelog for Thu Sep 16 17:17:55 PDT 1993

---
 ChangeLog.n                |  23 +++++++
 clim/completer.lisp        |  24 ++++---
 demo/address-book.lisp     |  23 +------
 demo/bitmap-editor.lisp    |  26 ++------
 demo/browser.lisp          |  22 +------
 demo/cad-demo.lisp         |  22 +------
 demo/color-editor.lisp     |  23 +------
 demo/custom-records.lisp   |  23 ++-----
 demo/demo-activity.lisp    |  19 +-----
 demo/demo-driver.lisp      | 128 +++++++++++++++++++++++--------------
 demo/graphics-demos.lisp   |  19 +-----
 demo/graphics-editor.lisp  |  23 +------
 demo/ico.lisp              |  22 +------
 demo/listener.lisp         |  22 +------
 demo/navfun.lisp           |  22 +------
 demo/palette.lisp          |  12 +---
 demo/peek-frame.lisp       |  22 +------
 demo/plot.lisp             |  23 ++-----
 demo/process-browser.lisp  |  21 +-----
 demo/puzzle.lisp           |  22 +------
 demo/thinkadot.lisp        |  24 ++-----
 test/test-demos.lisp       |  18 +++---
 test/test-suite.lisp       |  21 ++----
 tk-silica/xt-frames.lisp   |  12 ++--
 tk-silica/xt-graphics.lisp |   9 +--
 25 files changed, 196 insertions(+), 429 deletions(-)

diff --git a/ChangeLog.n b/ChangeLog.n
index 5ee9e768..3cea86cb 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -1,3 +1,26 @@
+from colin: Thu Sep 16 17:17:55 PDT 1993
+
+clim/completer.lisp		fix to clim2bug600
+
+demo/demo-driver.lisp		use an application-frame rather than menu
+
+demo/address-book.lisp, demo/bitmap-editor.lisp, demo/browser.lisp,
+demo/cad-demo.lisp, demo/color-editor.lisp, demo/custom-records.lisp,
+demo/demo-activity.lisp, demo/graphics-demos.lisp
+demo/graphics-editor.lisp, demo/ico.lisp, demo/listener.lisp,
+demo/navfun.lisp, demo/palette.lisp, demo/peek-frame.lisp, demo/plot.lisp
+demo/process-browser.lisp, demo/puzzle.lisp, demo/thinkadot.lisp,
+test/test-suite.lisp
+	replaced (defvar *xxx's*) and (defun do-xxx) with 
+	(define-demo ...) which does it all	
+
+test/test-demos.lisp		run-all-demos knows about new demo-driver
+
+tk-silica/xt-frames.lisp	fix-coordinates in update-frame-settings
+tk-silica/xt-graphics.lisp	use lookup-color instead of parse-color
+
+-------------------------------------------------------------------------------
+
 from colin: Tue Sep  7 14:42:57 PDT 1993
 
 Makefile.defs			now using devel.17
diff --git a/clim/completer.lisp b/clim/completer.lisp
index 3aa54127..e8e0c4ff 100644
--- a/clim/completer.lisp
+++ b/clim/completer.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: completer.lisp,v 1.13 92/10/28 11:31:28 cer Exp $
+;; $fiHeader: completer.lisp,v 1.14 1993/07/27 01:38:33 colin Exp $
 
 (in-package :clim-internals)
 
@@ -73,15 +73,19 @@
 	 (declare (dynamic-extent #'ends-in-char-p))
 	 (loop
 	   (setq unread nil return nil extend nil)
-	   (with-input-context (`(completer :stream ,stream
-					    :function ,function
-					    :possibility-printer ,possibility-printer
-					    :prefix ,stuff-so-far
-					    :location ,location)) ()
-		(progn 
-		  (setq token (read-token stream))
-		  (setq ch (read-gesture :stream stream)))
-	      (t (beep stream)))
+	   (block get-input
+	     (loop
+	       (with-input-context (`(completer :stream ,stream
+						:function ,function
+						:possibility-printer
+						,possibility-printer 
+						:prefix ,stuff-so-far
+						:location ,location)) ()
+		   (return-from get-input
+		     (progn 
+		       (setq token (read-token stream))
+		       (setq ch (read-gesture :stream stream))))
+		   (t nil))))
 	   (extend-vector stuff-so-far token)
 	   (cond ((null ch)
 		  (error "Null character?"))
diff --git a/demo/address-book.lisp b/demo/address-book.lisp
index 85c39cfc..6f306251 100644
--- a/demo/address-book.lisp
+++ b/demo/address-book.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: address-book.lisp,v 1.19 93/01/18 13:54:57 cer Exp $
+;; $fiHeader: address-book.lisp,v 1.20 1993/07/27 01:45:06 colin Exp $
 
 (in-package :clim-demo)
 
@@ -198,22 +198,5 @@
     (setf (address-number address) new-number)))
 
 
-(defvar *address-books* nil)
-
-(defun do-address-book (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *address-books*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'address-book
-						   :frame-manager framem
-						   :left 100
-						   :width 400 :height 300)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *address-books*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Address Book" do-address-book)
+
+(define-demo "Address Book" address-book :left 100 :width 400 :height 300)
diff --git a/demo/bitmap-editor.lisp b/demo/bitmap-editor.lisp
index 00875b03..d30f7038 100644
--- a/demo/bitmap-editor.lisp
+++ b/demo/bitmap-editor.lisp
@@ -1,7 +1,7 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
 ;;
-;;				-[Thu Jul 22 17:12:46 1993 by colin]-
+;;				-[Mon Sep 13 17:49:24 1993 by colin]-
 ;; 
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
 ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
@@ -21,7 +21,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: bitmap-editor.lisp,v 1.15 1993/07/22 15:38:18 cer Exp $
+;; $fiHeader: bitmap-editor.lisp,v 1.16 1993/07/27 01:45:10 colin Exp $
 
 (in-package :clim-demo)
 
@@ -216,22 +216,6 @@
   (list presentation object))
 
 
-(defvar *bitmap-editors* nil)
-
-(defun do-bitmap-editor (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *bitmap-editors*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'bitmap-editor
-						   :frame-manager framem
-						   :left 100 :top 100
-						   :width 700 :height 500)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *bitmap-editors*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Bitmap Editor" do-bitmap-editor)
+
+(define-demo "Bitmap Editor" bitmap-editor
+  :left 100 :top 100 :width 700 :height 500)
diff --git a/demo/browser.lisp b/demo/browser.lisp
index 74bce88a..227378b4 100644
--- a/demo/browser.lisp
+++ b/demo/browser.lisp
@@ -3,7 +3,7 @@
 ;;; Simple extensible browser
 ;;; Scott McKay
 
-;; $fiHeader: browser.lisp,v 1.22 93/04/23 09:17:50 cer Exp $
+;; $fiHeader: browser.lisp,v 1.23 1993/07/22 15:38:20 cer Exp $
 
 (in-package :clim-browser)
 
@@ -1460,21 +1460,5 @@
     (frame-exit frame)))
 
 
-(defvar *browsers* nil)
-
-(defun do-browser (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *browsers*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'browser
-						   :frame-manager framem
-						   :width 800 :height 700)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *browsers*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Graphical Browser" do-browser)
+
+(define-demo "Graphical Browser" browser :width 800 :height 700)
diff --git a/demo/cad-demo.lisp b/demo/cad-demo.lisp
index 988cbd78..efef6e9e 100644
--- a/demo/cad-demo.lisp
+++ b/demo/cad-demo.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cad-demo.lisp,v 1.22 92/12/03 10:28:33 cer Exp $
+;; $fiHeader: cad-demo.lisp,v 1.23 1993/07/27 01:45:14 colin Exp $
 
 (in-package :clim-demo)
 
@@ -880,21 +880,5 @@ but first get better menu formatting!
 ||#
 
 
-(defvar *cad-demos* nil)
-
-(defun do-cad-demo (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *cad-demos*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'cad-demo
-						   :frame-manager framem
-						   :width 700 :height 600)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *cad-demos*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "CAD Demo" do-cad-demo)
+
+(define-demo "CAD Demo" cad-demo :width 700 :height 600)
diff --git a/demo/color-editor.lisp b/demo/color-editor.lisp
index 23544ecd..4ea11153 100644
--- a/demo/color-editor.lisp
+++ b/demo/color-editor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: color-editor.lisp,v 1.10 92/11/06 19:02:48 cer Exp $
+;; $fiHeader: color-editor.lisp,v 1.11 1993/07/27 01:45:18 colin Exp $
 
 (in-package :clim-demo)
 
@@ -175,22 +175,5 @@
 	(redisplay-frame-pane (pane-frame slider) 'display)))))
 
 
-(defvar *color-choosers* nil)
-
-(defun do-color-chooser (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *color-choosers*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'color-chooser
-						   :frame-manager framem)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *color-choosers*))
-	     frame)))
-    (run-frame-top-level frame)
-    ;; Return the actual RGB color...
-    (color frame)))
-
-(define-demo "Color Chooser" do-color-chooser)
+
+(define-demo "Color Chooser" color-chooser)
diff --git a/demo/custom-records.lisp b/demo/custom-records.lisp
index 386053f2..a2966b05 100644
--- a/demo/custom-records.lisp
+++ b/demo/custom-records.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: custom-records.lisp,v 1.3 92/12/03 10:28:36 cer Exp $
+;; $fiHeader: custom-records.lisp,v 1.4 1993/07/22 15:38:27 cer Exp $
 
 (in-package :clim-user)
 
@@ -508,21 +508,6 @@
       (terpri stream))))
 
 
-(defvar *scigraphs* nil)
-
-(defun do-scigraph (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *scigraphs*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'scigraph
-			     :left 200 :top 100 :width 600 :height 500
-			     :frame-manager framem)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *scigraphs*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(clim-demo:define-demo "Custom Output Records" do-scigraph)
+
+(clim-demo:define-demo "Custom Output Records" scigraph
+  :left 200 :top 100 :width 600 :height 500)
diff --git a/demo/demo-activity.lisp b/demo/demo-activity.lisp
index c3c9a9d1..86da770c 100644
--- a/demo/demo-activity.lisp
+++ b/demo/demo-activity.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: demo-activity.lisp,v 1.6 1993/05/13 16:23:38 cer Exp $
+;; $fiHeader: demo-activity.lisp,v 1.7 1993/06/04 16:06:29 cer Exp $
 
 (in-package :clim-demo)
 
@@ -70,20 +70,5 @@
   `(,object))
 
 
-(defvar *activity-demos* nil)
 
-(defun do-activity-demo (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *activity-demos*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-instance 'demo-activity
-			     :frame-manager framem)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *activity-demos*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Activity Demo" do-activity-demo)
+(define-demo "Activity Demo" activity-frame)
diff --git a/demo/demo-driver.lisp b/demo/demo-driver.lisp
index d8516f9d..df0580e6 100644
--- a/demo/demo-driver.lisp
+++ b/demo/demo-driver.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: demo-driver.lisp,v 1.23 93/01/11 15:44:58 colin Exp $
+;; $fiHeader: demo-driver.lisp,v 1.24 1993/07/27 01:45:21 colin Exp $
 
 (in-package :clim-demo)
 
@@ -8,52 +8,86 @@
 
 (defvar *demos* nil)
 
-(defmacro define-demo (name start-form)
-  (if (symbolp start-form)
-      `(clim-utils:push-unique (cons ,name ',start-form) *demos*
-			       :test #'string-equal :key #'car)
-      `(clim-utils:push-unique (cons ,name #'(lambda () ,start-form)) *demos*
-			       :test #'string-equal :key #'car)))
-
-(define-demo "Exit" (exit-demo))
-
-(defun exit-demo () (throw 'exit-demo nil))
-
-(define-demo "Test Suite" run-the-test-suite)
-
-(defun run-the-test-suite (&key (port (find-port)) (force nil))
-  (when (fboundp 'clim-user::do-test-suite)
-    (clim-user::do-test-suite :port port :force force)))
-
-(defun start-demo (&key (port (find-port)) force)
-  (let* ((framem (typecase port
-		   (frame-manager port)
-		   (t (find-frame-manager :port port))))
-	 (graft (typecase port
-		  (frame-manager (graft port))
-		  (t (find-graft :port port))))
-	 (*application-frame* 
-	   (make-application-frame 'standard-application-frame
-	     :frame-manager framem))
-	 (demos (sort (copy-list (map 'list #'car *demos*)) #'string<)))
-    (catch 'exit-demo
-      (loop
-	(let* ((demo-name 
-		 (menu-choose demos
-			      :text-style '(:serif :roman :large)
-			      :label '("Clim Demonstrations"
-				       :text-style (:serif :bold :normal))
-			      :associated-window graft
-			      :cache nil
-			      :unique-id 'demo-menu :id-test #'eql
-			      :cache-value *demos* :cache-test #'equal))
-	       (demo-fcn
-		 (cdr (assoc demo-name *demos* :test #'string-equal))))
-	  (cond ((null demo-fcn))
-		((functionp demo-fcn)
-		 (funcall demo-fcn))
-		(t
-		 (funcall demo-fcn :port port :force force))))))))
+(defclass demo ()
+  ((name :reader demo-name :initarg :name)
+   (class :reader demo-class :initarg :class)
+   (initargs :reader demo-initargs :initarg :initargs)
+   (frames :accessor demo-frames :initform nil)))
+
+(defmacro define-demo (name class &rest initargs)
+  (let ((do-name (clim-utils:fintern "~A-~A" 'do class)))
+    `(let ((demo (make-instance 'demo :name ,name 
+				:class ',class :initargs ',initargs)))
+       (clim-utils:push-unique demo
+			       *demos* :test #'string-equal :key #'demo-name)
+       (defun ,do-name (&rest args)
+	 (apply #'run-demo demo args)))))
+
+(when (find-class 'clim-user::clim-tests nil)
+  (define-demo "Test Suite" clim-user::clim-tests :width 600 :height 420))
+
+(define-application-frame demo-driver ()
+    ()
+  (:panes 
+   (display :application :display-function 'display-all-demos
+	    :display-time nil :scroll-bars nil
+	    :text-cursor nil
+	    :width :compute :height :compute
+	    :end-of-line-action :allow
+	    :end-of-page-action :allow))
+  (:pointer-documentation t)
+  (:layouts
+   (default display)))
+
+(defmethod display-all-demos ((frame demo-driver) stream &rest args)
+  (declare (ignore args))
+  (with-text-style (stream '(:serif :roman :large))
+    (dolist (demo (sort (copy-list *demos*) #'string< :key #'demo-name))
+      (let ((name (demo-name demo)))
+	(with-output-as-presentation (stream demo 'demo)
+	  (format stream "~A~%" name))))))
+
+(define-demo-driver-command (com-exit-demo-driver :menu t :name "Exit") ()
+  (frame-exit *application-frame*))
+
+(define-demo-driver-command (com-run-demo)
+    ((demo 'demo :gesture :select))
+  (mp:process-run-function (demo-name demo) 
+			   #'run-demo demo
+			   :port (port *application-frame*)))
+
+(define-gesture-name :shift-select :pointer-button (:left :shift))
+
+(define-demo-driver-command (com-force-demo)
+    ((demo 'demo :gesture :shift-select))
+  (mp:process-run-function (demo-name demo) 
+			   #'run-demo demo
+			   :port (port *application-frame*) :force t))
+
+(defun run-demo (demo &key (port (find-port)) force)
+  (let* ((entry (assoc port (demo-frames demo)))
+	 (frame (cdr entry)))
+    (when (or force (null frame))
+      (setq frame (apply #'make-application-frame
+			 (demo-class demo)
+			 :frame-manager (find-frame-manager :port port)
+			 (demo-initargs demo))))
+    (if entry
+	(setf (cdr entry) frame)
+      (push (cons port frame) (demo-frames demo)))
+    (case (frame-state frame)
+      ((:enabled :shrunk)
+       (note-frame-deiconified (frame-manager frame) frame)
+       (raise-frame frame))
+      (t
+       (run-frame-top-level frame)))))
+
+(let ((demo (make-instance 'demo :name "Demo Driver"
+			   :class 'demo-driver
+			   :initargs '(:left 0 :top 0))))
+  (defun start-demo (&rest args)
+    (apply #'run-demo demo args)))
+
 
 #+Genera
 (cp:define-command (si:com-demonstrate-clim
diff --git a/demo/graphics-demos.lisp b/demo/graphics-demos.lisp
index 20e37951..98b23c72 100644
--- a/demo/graphics-demos.lisp
+++ b/demo/graphics-demos.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graphics-demos.lisp,v 1.13 92/12/16 16:47:32 cer Exp $
+;; $fiHeader: graphics-demos.lisp,v 1.14 1993/07/27 01:45:28 colin Exp $
 
 (in-package :clim-demo)
 
@@ -240,20 +240,5 @@ to the window in which it is displayed."
 	(write-string text window)))))
 
 
-(defvar *graphics-demos* nil)
 
-(defun do-graphics-demo (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *graphics-demos*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'graphics-demo
-						   :frame-manager framem)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *graphics-demos*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Graphics Demos" do-graphics-demo)
+(define-demo "Graphics Demos" graphics-demo)
diff --git a/demo/graphics-editor.lisp b/demo/graphics-editor.lisp
index 3027a28e..e4c2979d 100644
--- a/demo/graphics-editor.lisp
+++ b/demo/graphics-editor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-GRAPHICS-EDITOR; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graphics-editor.lisp,v 1.20 1993/05/25 20:41:33 cer Exp $
+;; $fiHeader: graphics-editor.lisp,v 1.21 1993/06/02 18:41:24 cer Exp $
 
 (in-package :clim-graphics-editor)
 
@@ -623,23 +623,6 @@
 	      (car layouts)))))
 
 
-(defvar *graphics-editors* nil)
-
-(defun do-graphics-editor (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *graphics-editors*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'graphics-editor
-						   :frame-manager framem
-						   :left 100 :top 100
-						   :width 800 :height 500)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *graphics-editors*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Graphics Editor" do-graphics-editor)
+(define-demo "Graphics Editor" graphics-editor
+  :left 100 :top 100 :width 800 :height 500)
 
diff --git a/demo/ico.lisp b/demo/ico.lisp
index fb7f0a30..696c57b3 100644
--- a/demo/ico.lisp
+++ b/demo/ico.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: ico.lisp,v 1.17 92/12/16 16:47:36 cer Exp $
+;; $fiHeader: ico.lisp,v 1.18 1993/07/27 01:45:32 colin Exp $
 
 ;;;
 ;;; Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved. 
@@ -576,21 +576,5 @@
 (setq xform (create-xform))
 
 
-(defvar *ico-frames* nil)
-
-(defun do-ico (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *ico-frames*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'ico-frame
-						   :frame-manager framem
-						   :left 200 :top 50)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *ico-frames*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Ico Demo" do-ico)
+
+(define-demo "Ico Demo" ico-frame :left 200 :top 50)
diff --git a/demo/listener.lisp b/demo/listener.lisp
index 6738766e..b5c5b2c3 100644
--- a/demo/listener.lisp
+++ b/demo/listener.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: listener.lisp,v 1.29 93/01/21 14:58:34 cer Exp $
+;; $fiHeader: listener.lisp,v 1.30 1993/07/22 15:38:29 cer Exp $
 
 (in-package :clim-demo)
 
@@ -648,24 +648,8 @@
 	  (present '(com-quit) ptype))))))
 
 
-(defvar *listeners* nil)
-
-(defun do-lisp-listener (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *listeners*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'lisp-listener
-						   :frame-manager framem
-						   :width 600 :height 500)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *listeners*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Lisp Listener" do-lisp-listener)
+
+(define-demo "Lisp Listener" lisp-listener :width 600 :height 500)
 
 #+Genera
 (define-genera-application lisp-listener
diff --git a/demo/navfun.lisp b/demo/navfun.lisp
index f7041a16..ca863407 100644
--- a/demo/navfun.lisp
+++ b/demo/navfun.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: navfun.lisp,v 1.25 1993/07/22 15:38:31 cer Exp $
+;; $fiHeader: navfun.lisp,v 1.26 1993/07/27 01:45:39 colin Exp $
 
 (in-package :clim-demo)
 
@@ -1651,21 +1651,5 @@
   t)
 
 
-(defvar *flight-planners* nil)
-
-(defun do-flight-planner (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *flight-planners*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'flight-planner
-						   :frame-manager framem
-						   :width 1000 :height 800)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *flight-planners*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Flight Planner" do-flight-planner)
+
+(define-demo "Flight Planner" flight-planner :width 1000 :height 800)
diff --git a/demo/palette.lisp b/demo/palette.lisp
index fee37719..ab84c148 100644
--- a/demo/palette.lisp
+++ b/demo/palette.lisp
@@ -1,7 +1,7 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
 ;;
-;;				-[]-
+;;				-[Mon Sep 13 17:55:07 1993 by colin]-
 ;; 
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
 ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
@@ -21,7 +21,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: palette.lisp,v 1.3 92/10/07 14:43:43 cer Exp $
+;; $fiHeader: palette.lisp,v 1.4 1993/07/27 01:45:51 colin Exp $
 
 
 (in-package :clim-demo)
@@ -59,12 +59,6 @@ text field gadget"
 	text-field text-editor list-pane option-pane))))
 
 
-(defvar *gadget-demo* nil)
 
-(defun do-gadget-demo (&optional force)
-  (run-frame-top-level 
-    (or (and (not force) *gadget-demo*)
-	(setq *gadget-demo* (make-application-frame 'gadget-demo)))))
-
-(define-demo "Gadget demo" (do-gadget-demo))
+(define-demo "Gadget demo" gadget-demo)
 
diff --git a/demo/peek-frame.lisp b/demo/peek-frame.lisp
index 7e0b95d0..8b317793 100644
--- a/demo/peek-frame.lisp
+++ b/demo/peek-frame.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: peek-frame.lisp,v 1.4 93/03/19 09:44:12 cer Exp $
+;; $fiHeader: peek-frame.lisp,v 1.5 1993/07/27 01:45:54 colin Exp $
 
 (in-package :clim-user)
 
@@ -319,21 +319,5 @@ Revised and stripped down by Scott McKay (SWM@Symbolics.COM) for CLIM 2.0.
       (close pipe))))
 
 
-(defvar *peek-frames* nil)
-
-(defun do-peek (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *peek-frames*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'peek-frame
-			     :width 700 :height 450
-			     :frame-manager framem)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *peek-frames*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(clim-demo:define-demo "Peek" do-peek)
+
+(clim-demo:define-demo "Peek" peek-frame :width 700 :height 450)
diff --git a/demo/plot.lisp b/demo/plot.lisp
index 85ed7ace..83a369cf 100644
--- a/demo/plot.lisp
+++ b/demo/plot.lisp
@@ -1,7 +1,7 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
 ;;
-;;				-[Mon Aug 23 14:13:24 1993 by colin]-
+;;				-[Mon Sep 13 17:55:50 1993 by colin]-
 ;; 
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
 ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
@@ -21,7 +21,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: plot.lisp,v 1.26 1993/08/12 16:03:37 cer Exp $
+;; $fiHeader: plot.lisp,v 1.27 1993/09/07 21:46:27 colin Exp $
 
 (in-package :clim-demo)
 
@@ -810,20 +810,5 @@
 	    (setf plot-data (read s))))))))
 
 
-(defvar *plot-demos* nil)
-
-(defun do-plot-demo (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *plot-demos*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'plot-demo
-						   :frame-manager framem)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *plot-demos*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Plotting Demo" do-plot-demo)
+
+(define-demo "Plotting Demo" plot-demo)
diff --git a/demo/process-browser.lisp b/demo/process-browser.lisp
index 86ad6976..1cd06172 100644
--- a/demo/process-browser.lisp
+++ b/demo/process-browser.lisp
@@ -1,7 +1,7 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
 ;;
-;;				-[]-
+;;				-[Mon Sep 13 17:56:12 1993 by colin]-
 ;; 
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
 ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
@@ -21,7 +21,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: process-browser.lisp,v 1.6 92/11/05 17:15:51 cer Exp $
+;; $fiHeader: process-browser.lisp,v 1.7 1993/07/27 01:46:02 colin Exp $
 
 
 (in-package :clim-demo)
@@ -168,20 +168,5 @@
 			    (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)
+(define-demo "Process Browser" process-browser)
diff --git a/demo/puzzle.lisp b/demo/puzzle.lisp
index cb757939..d3915802 100644
--- a/demo/puzzle.lisp
+++ b/demo/puzzle.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: puzzle.lisp,v 1.22 92/11/06 19:03:05 cer Exp $
+;; $fiHeader: puzzle.lisp,v 1.23 1993/07/27 01:46:05 colin Exp $
 
 (in-package :clim-demo)
 
@@ -173,21 +173,5 @@
   (frame-exit *application-frame*))
 
 
-(defvar *puzzles* nil)
-
-(defun do-puzzle (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *puzzles*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'puzzle
-						   :left 200 :top 100
-						   :frame-manager framem)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *puzzles*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "15 Puzzle" do-puzzle)
+
+(define-demo "15 Puzzle" puzzle :left 200 :top 100)
diff --git a/demo/thinkadot.lisp b/demo/thinkadot.lisp
index 4b52f3ff..e8ef2e9f 100644
--- a/demo/thinkadot.lisp
+++ b/demo/thinkadot.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: thinkadot.lisp,v 1.13 92/10/07 14:43:52 cer Exp $
+;; $fiHeader: thinkadot.lisp,v 1.14 1993/07/27 01:46:11 colin Exp $
 
 (in-package :clim-demo)
 
@@ -177,22 +177,6 @@
   (frame-exit *application-frame*))
 
 
-(defvar *thinkadots* nil)
-
-(defun do-thinkadot (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *thinkadots*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'thinkadot
-						   :frame-manager framem
-						   :left 100 :top 100
-						   :width 300 :height 340)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *thinkadots*))
-	     frame)))
-    (run-frame-top-level frame)))
-
-(define-demo "Thinkadot" do-thinkadot)
+
+(define-demo "Thinkadot" thinkadot
+  :left 100 :top 100 :width 300 :height 340)
diff --git a/test/test-demos.lisp b/test/test-demos.lisp
index 190d3938..5668d87b 100644
--- a/test/test-demos.lisp
+++ b/test/test-demos.lisp
@@ -1,6 +1,6 @@
 (in-package :clim-user)
 
-;; $fiHeader: test-demos.lisp,v 1.4 1993/07/22 15:39:09 cer Exp $
+;; $fiHeader: test-demos.lisp,v 1.5 1993/08/12 16:04:30 cer Exp $
 
 (define-frame-test test-puzzle-demo (clim-demo::puzzle)
   (
@@ -217,15 +217,13 @@
 
 (defun run-all-demos ()
   (dolist (demo clim-demo::*demos*)
-    (let ((fn (cdr demo)))
-      (unless (functionp fn)
-	(handler-case (mp::with-timeout (20)
-			(funcall fn :force t))
-	  (error (c)
-	    (note-test-failed fn c))
-	  (:no-error (&rest ignore)
-	    (declare (ignore ignore))
-	    (note-test-succeeded fn)))))))
+    (handler-case (mp::with-timeout (20)
+		    (clim-demo::run-demo demo :force t))
+      (error (c)
+	(note-test-failed (clim-demo::demo-class demo) c))
+      (:no-error (&rest ignore)
+	(declare (ignore ignore))
+	(note-test-succeeded (clim-demo::demo-class demo))))))
 
 ;;-- I dont know whether this is the best place for this?
 
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 33bb219c..7c25e9b1 100644
--- a/test/test-suite.lisp
+++ b/test/test-suite.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: test-suite.lisp,v 1.69 1993/07/27 22:29:27 colin Exp $
+;; $fiHeader: test-suite.lisp,v 1.70 1993/07/30 23:58:14 colin Exp $
 
 (in-package :clim-user)
 
@@ -3410,19 +3410,6 @@ Luke Luck licks the lakes Luke's duck likes."))
     ()
   (frame-exit *application-frame*))
 
-(defvar *test-suites* nil)
-
-(defun do-test-suite (&key (port (find-port)) (force nil))
-  (let* ((framem (find-frame-manager :port port))
-	 (frame 
-	   (let* ((entry (assoc port *test-suites*))
-		  (frame (cdr entry)))
-	     (when (or force (null frame))
-	       (setq frame (make-application-frame 'clim-tests
-						   :frame-manager framem
-						   :width 600 :height 420)))
-	     (if entry 
-		 (setf (cdr entry) frame)
-		 (push (cons port frame) *test-suites*))
-	     frame)))
-    (run-frame-top-level frame)))
+
+
+
diff --git a/tk-silica/xt-frames.lisp b/tk-silica/xt-frames.lisp
index d492280d..faf712d0 100644
--- a/tk-silica/xt-frames.lisp
+++ b/tk-silica/xt-frames.lisp
@@ -1,6 +1,6 @@
 ;; -*- mode: common-lisp; package: xm-silica -*-
 ;;
-;;				-[Thu Aug 26 18:34:07 1993 by colin]-
+;;				-[Wed Sep  8 11:40:41 1993 by colin]-
 ;; 
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
 ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA  All rights reserved.
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-frames.lisp,v 1.38 1993/08/12 16:05:10 cer Exp $
+;; $fiHeader: xt-frames.lisp,v 1.39 1993/09/07 21:47:14 colin Exp $
 
 
 (in-package :xm-silica)
@@ -251,12 +251,12 @@
   (let ((graft (graft framem))
 	(shell (sheet-shell (frame-top-level-sheet frame))))
     (let* ((sr (compose-space (frame-top-level-sheet frame)))
-	   (width (fix-coordinate (space-requirement-min-width sr)))
-	   (height (fix-coordinate (space-requirement-min-height sr))))
+	   (width (space-requirement-min-width sr))
+	   (height (space-requirement-min-height sr)))
       (clim-internals::limit-size-to-graft width height graft)
       (tk::set-values shell
-		      :min-width width
-		      :min-height height))
+		      :min-width (fix-coordinate width)
+		      :min-height (fix-coordinate height)))
 
     (let ((geo (clim-internals::frame-geometry frame)))
       (destructuring-bind
diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp
index 16414dea..b7ef9d72 100644
--- a/tk-silica/xt-graphics.lisp
+++ b/tk-silica/xt-graphics.lisp
@@ -1,6 +1,6 @@
 ;; -*- mode: common-lisp; package: tk-silica -*-
 ;;
-;;				-[Thu Aug 19 18:38:51 1993 by colin]-
+;;				-[Mon Sep 13 18:25:58 1993 by colin]-
 ;; 
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
 ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA  All rights reserved.
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-graphics.lisp,v 1.77 1993/07/27 01:55:47 colin Exp $
+;; $fiHeader: xt-graphics.lisp,v 1.78 1993/09/07 21:47:23 colin Exp $
 
 (in-package :tk-silica)
 
@@ -151,10 +151,7 @@
     (setq name (substitute #\space #\- (string name)))
     (or (gethash name named-color-cache)
 	(setf (gethash name named-color-cache)
-	  ;; we use parse-color rather than lookup-color here because
-	  ;; it also understands about #rgb format. in R5 we should
-	  ;; change this to lookup-color
-	  (let ((xcolor (tk::parse-color (palette-colormap palette) name))
+	  (let ((xcolor (tk::lookup-color (palette-colormap palette) name))
 		(x #.(1- (ash 1 16))))
 	    (if xcolor
 		(make-rgb-color (/ (x11:xcolor-red xcolor) x)
-- 
GitLab