/[cl-menusystem]/cl-menusystem/test.lisp
ViewVC logotype

Contents of /cl-menusystem/test.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (vendor branch)
Tue Sep 23 23:53:00 2003 UTC (10 years, 6 months ago) by bmastenbrook
Branch: MAIN, cl-menusystem
CVS Tags: start, HEAD
Changes since 1.1: +0 -0 lines
Initial import
1 (defpackage #:cl-menusystem-test
2 (:use #:cl-menusystem #:common-lisp)
3 (:export *test-menu* *a-string*))
4
5 (in-package #:cl-menusystem-test)
6
7 (defvar *a-string* "Hi!")
8
9 (defmenu *test-menu* "A Menu" "Some Help"
10 (make-menu-action "Hello world!" nil
11 (rst) (format t "Hello yourself!~&"))
12 (make-menu "A random submenu" "Select an option from this submenu"
13 (make-menu-action "Jump!" nil
14 (rst) (format t "Whee!~&"))
15 (make-menu-action "Exit to previous menu" nil
16 (rst) (invoke-restart rst)))
17 (make-menu-action "A submenu with two exits" nil
18 (toplevel-rst) (do-menu (make-menu "Two exits!" nil
19 (make-menu-action "Exit this submenu" nil
20 (rst) (invoke-restart rst))
21 (make-menu-action "Exit all the way" nil
22 (rst) (invoke-restart toplevel-rst "Foo!")))
23 *menu-output*
24 *menu-input*))
25 #|(make-menu "A preference" "This submenu allows you to edit cl-menusystem-test:*a-string*"
26 (make-state-presentable "Value of *a-string*" (format nil "*a-string*'s value is currently: ~A" *a-string*))
27 (make-menu-action "Edit the value of *a-string*" nil
28 (rst) (setf *a-string* (request-one-line-string *menu-output* *menu-input* "Set the value of *a-string*")))
29 (make-menu-action "Exit to previous menu" nil
30 (rst) (invoke-restart rst)))|#
31 (make-preference-menu cl-menusystem-test:*a-string*
32 :description "a string"
33 :extended-help "Please enter your name!"
34 :type :one-line-string
35 :present-form #'(lambda () (format nil "~A" *a-string*))
36 :default-values (("a random value" "Hello, world!"))
37 :convert-function #'(lambda (v) (format nil "Hello, ~A!" v)))
38 (make-menu-action "Exit this menu" nil
39 (rst) (invoke-restart rst 42)))

  ViewVC Help
Powered by ViewVC 1.1.5