commit 18c15185bc7715b5f5a53d1567728457b8a4af9e parent c5579d0babcd114ce6b9dac09e22dce88d1cc086 Author: Ryan Culpepper <ryanc@racket-lang.org> Date: Sun, 26 Oct 2008 23:03:53 +0000 macro stepper: tidied up menus svn: r12133 original commit: c8dbc9b7987d7b2466f32afa31503a736b375af8 Diffstat:
| M | collects/macro-debugger/view/frame.ss | | | 25 | +++++++++++++++++++++++++ |
1 file changed, 25 insertions(+), 0 deletions(-)
diff --git a/collects/macro-debugger/view/frame.ss b/collects/macro-debugger/view/frame.ss @@ -200,6 +200,31 @@ "(Debug) Catch internal errors?" (get-field debug-catch-errors? config))) + ;; fixup-menu : menu -> void + ;; Delete separators at beginning/end and duplicates in middle + (define/private (fixup-menu menu) + (define items + (filter (lambda (i) (not (send i is-deleted?))) + (send menu get-items))) + (define (delete-seps-loop items) + (if (and (pair? items) (is-a? (car items) separator-menu-item%)) + (begin (send (car items) delete) + (delete-seps-loop (cdr items))) + items)) + (define (middle-loop items) + (cond + [(and (pair? items) (is-a? (car items) separator-menu-item%)) + (middle-loop (delete-seps-loop (cdr items)))] + [(pair? items) + (middle-loop (cdr items))] + [else null])) + (middle-loop (delete-seps-loop items)) + (delete-seps-loop (reverse items)) + (void)) + + (for ([menu (send (get-menu-bar) get-items)]) + (fixup-menu menu)) + (frame:remove-empty-menus this) (frame:reorder-menus this))) ;; Stolen from stepper