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

.

Browse Source 
original commit: b4ddabcd5403090c1505a7ae7637d528dfcc982d
This commit is contained in:
Matthew Flatt 1999-07-21 23:57:32 +00:00
parent 4214a99403
commit 5efb890e32
1 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
src/mred/wrap/mred.ss
View File

@ -3653,7 +3653,7 @@
(define wx-menu-bar%
(class* wx:menu-bar% (wx<%>) (mred)
(inherit delete)
(inherit delete select-system)
(rename [super-append append]
[super-enable-top enable-top])
(private
@ -3671,20 +3671,24 @@
(send event get-meta-down)
(char? (send event get-key-code))
(let ([c (send event get-key-code)])
(and (or (char-alphabetic? c)
(char-numeric? c))
(let ([re (key-regexp c)])
(ormap
(lambda (i)
(let* ([data (send (mred->wx i) get-menu-data)]
[label (car data)]
[menu (cdr data)])
(if (regexp-match re label)
(begin
(send menu select)
#t)
#f)))
items)))))))))]
(or (and (char=? #\space c)
(eq? 'windows (system-type))
(select-system)
#t)
(and (or (char-alphabetic? c)
(char-numeric? c))
(let ([re (key-regexp c)])
(ormap
(lambda (i)
(let* ([data (send (mred->wx i) get-menu-data)]
[label (car data)]
[menu (cdr data)])
(if (regexp-match re label)
(begin
(send menu select)
#t)
#f)))
items))))))))))]
[get-mred (lambda () mred)]
[get-items (lambda () items)]
[append-item (lambda (item menu title)