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

no message

Browse Source 
original commit: 2711ca7727891e9e99871a9fe0267ab1e8138d6b
This commit is contained in:
Robby Findler 2001-04-09 01:06:43 +00:00
parent 62aa9de612
commit c8e89dfd65
6 changed files with 42 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/framework/private/gen-standard-menus.ss
View File

@ -1,7 +1,3 @@
#!/bin/sh
string=? ; exec mred -qr $0
(module gen-standard-menus mzscheme (module gen-standard-menus mzscheme
(require (lib "pretty.ss")) (require (lib "pretty.ss"))
(require (lib "list.ss")) (require (lib "list.ss"))
@ -60,14 +56,15 @@ string=? ; exec mred -qr $0
`(private-field `(private-field
[,(an-item->item-name item) [,(an-item->item-name item)
(and (,create-menu-item-name) (and (,create-menu-item-name)
(make-object (class (get-menu-item%) args (make-object (class100 (get-menu-item%) args
(rename [super-on-demand on-demand]) (rename [super-on-demand on-demand])
(override on-demand) (override
(define (on-demand) [on-demand
(lambda () (lambda ()
(,(an-item->on-demand-name item) this) (,(an-item->on-demand-name item) this)
(super-on-demand))) (super-on-demand))])
(apply super-init args)) (sequence
(apply super-init args)))
,(join menu-before-string menu-after-string ,(join menu-before-string menu-after-string
`(,(an-item->string-name item))) `(,(an-item->string-name item)))
,(menu-item-menu-name item) ,(menu-item-menu-name item)

2
collects/framework/private/text.ss
View File

@ -2,7 +2,7 @@
(require (lib "unitsig.ss") (require (lib "unitsig.ss")
(lib "class.ss") (lib "class.ss")
(lib "class100.ss") (lib "class100.ss")
"sig" "sig.ss"
"../macro.ss" "../macro.ss"
"../gui-utils-sig.ss" "../gui-utils-sig.ss"
(lib "mred-sig.ss" "mred") (lib "mred-sig.ss" "mred")

4
collects/tests/framework/frame.ss
View File

@ -1,5 +1,3 @@
#|
(define (test-creation name class-expression) (define (test-creation name class-expression)
(test (test
name name
@ -138,8 +136,6 @@
(test-open "frame:searchable open" 'frame:searchable%) (test-open "frame:searchable open" 'frame:searchable%)
(test-open "frame:text-info open" 'frame:text-info-file%) (test-open "frame:text-info open" 'frame:text-info-file%)
|#
(test (test
"set!-ing menu callback in standard-menus-frame" "set!-ing menu callback in standard-menus-frame"
(lambda (x) (eq? x 'passed)) (lambda (x) (eq? x 'passed))

6
collects/tests/framework/load.ss
View File

@ -7,11 +7,13 @@
(test (test
(string->symbol file) (string->symbol file)
void? void?
`(let ([orig-namespace (current-namespace)]) `(let ([mred-name
((current-module-name-resolver) '(lib "mred.ss" "mred") #f #f)]
[orig-namespace (current-namespace)])
(parameterize ([current-namespace (make-namespace)]) (parameterize ([current-namespace (make-namespace)])
(namespace-attach-module (namespace-attach-module
orig-namespace orig-namespace
((current-module-name-resolver) '(lib "mred.ss" "mred"))) mred-name)
(eval '(require (lib ,file "framework"))) (eval '(require (lib ,file "framework")))
(with-handlers ([(lambda (x) #t) (with-handlers ([(lambda (x) #t)
(lambda (x) (lambda (x)

1
collects/tests/framework/test-suite-utils.ss
View File

@ -2,6 +2,7 @@
(require (lib "launcher.ss" "launcher") (require (lib "launcher.ss" "launcher")
(lib "pretty.ss") (lib "pretty.ss")
(lib "list.ss") (lib "list.ss")
(lib "process.ss")
"debug.ss") "debug.ss")
(provide (provide