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

fixed top-level bug

Browse Source 
svn: r3820
This commit is contained in:
Robby Findler 2006-07-26 12:24:34 +00:00
parent 3d123be6c0
commit 45a02967aa
2 changed files with 62 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/drscheme/private/debug.ss
View File

@ -189,14 +189,17 @@ profile todo:
[(begin expr ...) [(begin expr ...)
;; Found a `begin', so expand/eval each contained ;; Found a `begin', so expand/eval each contained
;; expression one at a time ;; expression one at a time
(let i-loop ([exprs (syntax->list #'(expr ...))] (let ([exprs (syntax->list #'(expr ...))]
[last-one (list (void))]) [last-one (list (void))])
(let i-loop ()
(cond (cond
[(null? exprs) (apply values last-one)] [(null? exprs)
[else (i-loop (cdr exprs) (apply values last-one)]
(call-with-values [else
(λ () (loop (car exprs))) (let ([exp (car exprs)])
list))]))] (set! exprs (cdr exprs))
(set! last-one (call-with-values (λ () (loop exp)) list))
(i-loop))])))]
[_else [_else
;; Not `begin', so proceed with normal expand and eval ;; Not `begin', so proceed with normal expand and eval
(let* ([annotated (annotate-top (expand-syntax top-e) #f)]) (let* ([annotated (annotate-top (expand-syntax top-e) #f)])

40
collects/drscheme/private/frame.ss
View File

@ -32,8 +32,7 @@
(define basics-mixin (define basics-mixin
(mixin (frame:standard-menus<%>) (basics<%>) (mixin (frame:standard-menus<%>) (basics<%>)
(inherit get-edit-target-window get-edit-target-object get-menu-bar) (inherit get-edit-target-window get-edit-target-object get-menu-bar)
[define/private get-menu-bindings (define/private (get-menu-bindings)
(λ ()
(let ([name-ht (make-hash-table)]) (let ([name-ht (make-hash-table)])
(let loop ([menu-container (get-menu-bar)]) (let loop ([menu-container (get-menu-bar)])
(for-each (for-each
@ -45,26 +44,33 @@
(string->symbol (string->symbol
(keymap:canonicalize-keybinding-string (keymap:canonicalize-keybinding-string
(string-append (string-append
(case (system-type) (menu-item->prefix-string item)
[(windows) "c:"]
[(macosx macos) "d:"]
[(unix)
(case (send item get-x-shortcut-prefix)
[(meta) "m:"]
[(alt) "a:"]
[(ctl) "c:"]
[(ctl-m) "c:m;"])]
[else ""])
(case short-cut (case short-cut
[(#\;) "semicolon"] [(#\;) "semicolon"]
[(#\:) "colon"] [(#\:) "colon"]
[(#\space) "space"] [(#\space) "space"]
[else (string short-cut)]))))]) [else
(string short-cut)]))))])
(hash-table-put! name-ht keyname (send item get-plain-label)))))) (hash-table-put! name-ht keyname (send item get-plain-label))))))
(when (is-a? item menu-item-container<%>) (when (is-a? item menu-item-container<%>)
(loop item))) (loop item)))
(send menu-container get-items))) (send menu-container get-items)))
name-ht))] name-ht))
(define/private (menu-item->prefix-string item)
(apply
string-append
(map (λ (prefix)
(case prefix
[(alt) (if (eq? (system-type) 'windows)
"m:"
"a:")]
[(cmd) "d:"]
[(meta) "m:"]
[(ctl) "c:"]
[(shift) "s:"]
[(opt) "a:"]))
(send item get-shortcut-prefix))))
[define/private copy-hash-table [define/private copy-hash-table
(λ (ht) (λ (ht)
@ -86,8 +92,8 @@
(if (can-show-keybindings?) (if (can-show-keybindings?)
(let ([edit-object (get-edit-target-object)]) (let ([edit-object (get-edit-target-object)])
(let ([keymap (send edit-object get-keymap)]) (let ([keymap (send edit-object get-keymap)])
(let*-values ([(menu-names) (get-menu-bindings)]) (let* ([menu-names (get-menu-bindings)]
(let* ([table (send keymap get-map-function-table)] [table (send keymap get-map-function-table)]
[bindings (hash-table-map table list)] [bindings (hash-table-map table list)]
[w/menus [w/menus
(append (hash-table-map menu-names list) (append (hash-table-map menu-names list)
@ -97,7 +103,7 @@
(mzlib:list:sort (mzlib:list:sort
w/menus w/menus
(λ (x y) (string-ci<=? (cadr x) (cadr y))))]) (λ (x y) (string-ci<=? (cadr x) (cadr y))))])
(show-keybindings-to-user structured-list this))))) (show-keybindings-to-user structured-list this))))
(bell)))] (bell)))]
(define/private (bound-by-menu? binding menu-table) (define/private (bound-by-menu? binding menu-table)