/[mcclim]/mcclim/test.lisp
ViewVC logotype

Contents of /mcclim/test.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Sat Dec 2 08:01:08 2000 UTC (13 years, 4 months ago) by cvs
Branch: MAIN
Changes since 1.3: +2 -2 lines
minor changes
1 ;;; -*- Mode: Lisp; Package: CLIM-DEMO -*-
2
3 ;;; (c) copyright 1998,1999,2000 by Michael McDonald (mikemac@mikemac.com)
4 ;;; (c) copyright 2000 by
5 ;;; Robert Strandh (strandh@labri.u-bordeaux.fr)
6
7 ;;; This library is free software; you can redistribute it and/or
8 ;;; modify it under the terms of the GNU Library General Public
9 ;;; License as published by the Free Software Foundation; either
10 ;;; version 2 of the License, or (at your option) any later version.
11 ;;;
12 ;;; This library is distributed in the hope that it will be useful,
13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;;; Library General Public License for more details.
16 ;;;
17 ;;; You should have received a copy of the GNU Library General Public
18 ;;; License along with this library; if not, write to the
19 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;;; Boston, MA 02111-1307 USA.
21
22 (in-package :CLIM-DEMO)
23
24 (defun address-book ()
25 (declare (special frame fm port pane medium graft))
26 (loop for port in climi::*all-ports*
27 do (destroy-port port))
28 (setq climi::*all-ports* nil)
29 (setq frame (make-application-frame 'address-book))
30 (setq fm (frame-manager frame))
31 (setq port (climi::frame-manager-port fm))
32 (setq pane (frame-standard-output frame))
33 (setq medium (sheet-medium pane))
34 (setq graft (graft frame))
35 (run-frame-top-level frame))
36
37 (defun test-define-application-frame ()
38 (macroexpand '(define-application-frame address-book ()
39 ;; This application has two state variables, the currently displayed
40 ;; address and the window from which user queries should be read.
41 ((current-address :initform nil)
42 (interaction-pane )
43 (name-pane))
44 (:panes
45 (interactor :interactor)
46 (address :application
47 :incremental-redisplay t
48 :display-function 'display-current-address)
49 (names :application
50 :incremental-redisplay t
51 :display-function 'display-names))
52 (:layouts
53 (default
54 (vertically ()
55 (horizontally ()
56 address names)
57 interactor))))))

  ViewVC Help
Powered by ViewVC 1.1.5