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