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

make error message a little more informative

Browse Source
This commit is contained in:
Robby Findler 2015-12-29 21:25:28 -06:00
parent 196797b529
commit aeb2577715
1 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gui-lib/framework/test.rkt
View File

@ -644,16 +644,24 @@
(error menu-tag "active frame does not have menu bar")) (error menu-tag "active frame does not have menu bar"))
(send menu-bar on-demand) (send menu-bar on-demand)
(let* ([items (send menu-bar get-items)]) (let* ([items (send menu-bar get-items)])
(let loop ([items items] (let loop ([all-items-this-level items]
[items items]
[this-name (car item-names)] [this-name (car item-names)]
[wanted-names (cdr item-names)]) [wanted-names (cdr item-names)])
(cond (cond
[(null? items) [(null? items)
(error 'menu-select "didn't find a menu: ~e, entire list: ~e" this-name item-names)] (error 'menu-select
"didn't find a menu: ~e, desired list: ~e, all items at this level ~e"
this-name
item-names
(map (λ (x) (and (is-a? x labelled-menu-item<%>)
(send x get-plain-label)))
all-items-this-level))]
[else (let ([i (car items)]) [else (let ([i (car items)])
(cond (cond
[(not (is-a? i labelled-menu-item<%>)) [(not (is-a? i labelled-menu-item<%>))
(loop (cdr items) (loop all-items-this-level
(cdr items)
this-name this-name
wanted-names)] wanted-names)]
[(string=? this-name (send i get-plain-label)) [(string=? this-name (send i get-plain-label))
@ -664,12 +672,14 @@
[(and (not (null? wanted-names)) [(and (not (null? wanted-names))
(is-a? i menu-item-container<%>)) (is-a? i menu-item-container<%>))
(loop (send i get-items) (loop (send i get-items)
(send i get-items)
(car wanted-names) (car wanted-names)
(cdr wanted-names))] (cdr wanted-names))]
[else [else
(error menu-tag "no menu matching ~e" item-names)])] (error menu-tag "no menu matching ~e" item-names)])]
[else [else
(loop (cdr items) (loop all-items-this-level
(cdr items)
this-name this-name
wanted-names)]))]))))]))) wanted-names)]))]))))])))