suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: c2af16e54a52f76e2d48a162ae313c931aabfab8
This commit is contained in:
Matthew Flatt 2000-03-04 17:22:00 +00:00
parent 42f63a402b
commit 5da28fddd8
1 changed files with 14 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/tests/mred/item.ss
View File

@ -149,6 +149,15 @@
(lambda (n) (lambda (n)
(build-path d n))))) (build-path d n)))))
(define on-demand-menu-item%
(class menu-item% (name . args)
(override
[on-demand
(lambda ()
(printf "Menu item ~a demanded~n" name))])
(sequence
(apply super-init name args))))
(define popup-test-canvas% (define popup-test-canvas%
(class canvas% (objects names . args) (class canvas% (objects names . args)
(inherit popup-menu get-dc refresh) (inherit popup-menu get-dc refresh)
@ -201,6 +210,10 @@
m m
(make-callback))) (make-callback)))
objects names) objects names)
(make-object on-demand-menu-item%
"[on-demand hook]"
m
void)
m) m)
last-m)]) last-m)])
(set! last-m m) (set! last-m m)
@ -589,7 +602,7 @@
(set! ADD-BANANA (new "Add Banana")) (set! ADD-BANANA (new "Add Banana"))
(set! ADD-COCONUT (new "Add Coconut")) (set! ADD-COCONUT (new "Add Coconut"))
(make-object menu-item% "Append Donut" menu (make-object on-demand-menu-item% "Append Donut" menu
(lambda (m e) (lambda (m e)
(make-object menu-item% "Donut" apple-menu void))) (make-object menu-item% "Donut" apple-menu void)))
(sep) (sep)