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

19
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))])
(cond (let i-loop ()
[(null? exprs) (apply values last-one)] (cond
[else (i-loop (cdr exprs) [(null? exprs)
(call-with-values (apply values last-one)]
(λ () (loop (car exprs))) [else
list))]))] (let ([exp (car exprs)])
(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)])

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

@ -32,39 +32,45 @@
(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 (λ (item)
(λ (item) (when (is-a? item selectable-menu-item<%>)
(when (is-a? item selectable-menu-item<%>) (let ([short-cut (send item get-shortcut)])
(let ([short-cut (send item get-shortcut)]) (when short-cut
(when short-cut (let ([keyname
(let ([keyname (string->symbol
(string->symbol (keymap:canonicalize-keybinding-string
(keymap:canonicalize-keybinding-string (string-append
(string-append (menu-item->prefix-string item)
(case (system-type) (case short-cut
[(windows) "c:"] [(#\;) "semicolon"]
[(macosx macos) "d:"] [(#\:) "colon"]
[(unix) [(#\space) "space"]
(case (send item get-x-shortcut-prefix) [else
[(meta) "m:"] (string short-cut)]))))])
[(alt) "a:"] (hash-table-put! name-ht keyname (send item get-plain-label))))))
[(ctl) "c:"] (when (is-a? item menu-item-container<%>)
[(ctl-m) "c:m;"])] (loop item)))
[else ""]) (send menu-container get-items)))
(case short-cut name-ht))
[(#\;) "semicolon"]
[(#\:) "colon"] (define/private (menu-item->prefix-string item)
[(#\space) "space"] (apply
[else (string short-cut)]))))]) string-append
(hash-table-put! name-ht keyname (send item get-plain-label)))))) (map (λ (prefix)
(when (is-a? item menu-item-container<%>) (case prefix
(loop item))) [(alt) (if (eq? (system-type) 'windows)
(send menu-container get-items))) "m:"
name-ht))] "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,18 +92,18 @@
(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)
(filter (λ (binding) (not (bound-by-menu? binding menu-names))) (filter (λ (binding) (not (bound-by-menu? binding menu-names)))
bindings))] bindings))]
[structured-list [structured-list
(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)