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

..

Browse Source 
original commit: 42ee8b39c2914587be779271598f3c2f1b1cdffd
This commit is contained in:
Robby Findler 2003-01-01 17:18:55 +00:00
parent 15adacd282
commit 6cf7e741a5
1 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/tests/utils/gui.ss
View File

@ -82,7 +82,16 @@
;;; ((union #f string) (union class #f) area-container<%> -> window<%>)) ;;; ((union #f string) (union class #f) area-container<%> -> window<%>))
;;;; may call error, if no control with the label is found ;;;; may call error, if no control with the label is found
(define find-labelled-window (define find-labelled-window
(opt-lambda (label [class #f] [window (get-top-level-focus-window)]) (opt-lambda (label
[class #f]
[window (get-top-level-focus-window)]
[failure (lambda ()
(error 'find-labelled-window "no window labelled ~e in ~e~a"
label
window
(if class
(format " matching class ~e" class)
"")))])
(unless (or (not label) (unless (or (not label)
(string? label)) (string? label))
(error 'find-labelled-window "first argument must be a string or #f, got ~e; other args: ~e ~e" (error 'find-labelled-window "first argument must be a string or #f, got ~e; other args: ~e ~e"
@ -106,9 +115,4 @@
[(is-a? window area-container<%>) (ormap loop (send window get-children))] [(is-a? window area-container<%>) (ormap loop (send window get-children))]
[else #f]))]) [else #f]))])
(or ans (or ans
(error 'find-labelled-window "no window labelled ~e in ~e~a" (failure))))))
label
window
(if class
(format " matching class ~e" class)
"")))))))