From 9ae090e45b9f29fe756a3f7795550037dc043970 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 24 May 2006 23:01:45 +0000 Subject: [PATCH] * Remove a bunch of additional stuff from the bug-report menu * Rewrote `reorder-menus' to remove menus that are left empty * Solves PR7360 svn: r3052 --- collects/framework/private/frame.ss | 43 ++++++++------------ collects/framework/private/standard-menus.ss | 3 +- collects/help/bug-report.ss | 26 ++++++------ 3 files changed, 31 insertions(+), 41 deletions(-) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 31998fcb5f..635fed9737 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -33,40 +33,29 @@ [scheme : framework:scheme^] [exit : framework:exit^] [comment-box : framework:comment-box^]) - + (rename [-editor<%> editor<%>] [-pasteboard% pasteboard%] [-text% text%]) (define (reorder-menus frame) - (let* ([items (send (send frame get-menu-bar) get-items)] - [move-to-back - (λ (name items) - (let loop ([items items] - [back null]) - (cond - [(null? items) back] - [else (let ([item (car items)]) - (if (string=? (send item get-plain-label) name) - (loop (cdr items) - (cons item back)) - (cons item (loop (cdr items) back))))])))] - [move-to-front - (λ (name items) - (reverse (move-to-back name (reverse items))))] - [re-ordered - (move-to-front - (string-constant file-menu) - (move-to-front - (string-constant edit-menu) - (move-to-back - (string-constant help-menu) - (move-to-back - (string-constant windows-menu) - items))))]) + (define items (send (send frame get-menu-bar) get-items)) + (define (find-menu name) + (ormap (λ (i) (and (string=? (send i get-plain-label) name) i)) + items)) + (let* ([file-menu (find-menu (string-constant file-menu))] + [edit-menu (find-menu (string-constant edit-menu))] + [windows-menu (find-menu (string-constant windows-menu))] + [help-menu (find-menu (string-constant help-menu))] + [other-items + (remq* (list file-menu edit-menu windows-menu help-menu) items)] + [? (λ (menu) (and menu (pair? (send menu get-items)) menu))] + [re-ordered (filter values `(,(? file-menu) ,(? edit-menu) + ,@other-items + ,(? windows-menu) ,(? help-menu)))]) (for-each (λ (item) (send item delete)) items) (for-each (λ (item) (send item restore)) re-ordered))) - + (define (add-snip-menu-items edit-menu c%) (let* ([get-edit-target-object (λ () diff --git a/collects/framework/private/standard-menus.ss b/collects/framework/private/standard-menus.ss index 547237a196..a2afbbe519 100644 --- a/collects/framework/private/standard-menus.ss +++ b/collects/framework/private/standard-menus.ss @@ -159,8 +159,7 @@ (define remove-prefs-callback (preferences:add-callback 'framework:menu-bindings - (λ - (p v) + (λ (p v) (let loop ((menu (get-menu-bar))) (when (is-a? menu menu:can-restore<%>) (if v (send menu restore-keybinding) (send menu set-shortcut #f))) diff --git a/collects/help/bug-report.ss b/collects/help/bug-report.ss index 168ba7dcb0..865e6b2abf 100644 --- a/collects/help/bug-report.ss +++ b/collects/help/bug-report.ss @@ -22,21 +22,23 @@ ;; this one should be defined by help desk. (define frame-mixin (namespace-variable-value 'help-desk:frame-mixin #f (lambda () (lambda (x) x)))) - + (preferences:set-default 'drscheme:email "" string?) (preferences:set-default 'drscheme:full-name "" string?) - (define (remove-extra-blanks %) - (class % - (define/override (edit-menu:between-find-and-preferences menu) (void)) - (super-instantiate ()))) - (define bug-frame% - (class (frame-mixin (remove-extra-blanks (frame:standard-menus-mixin frame:basic%))) + (class (frame-mixin (frame:standard-menus-mixin frame:basic%)) (init title) + ;; a bunch of stuff we don't want (define/override (file-menu:between-print-and-close menu) (void)) - + (define/override (edit-menu:between-find-and-preferences menu) (void)) + (define/override (file-menu:create-open?) #f) + (define/override (file-menu:create-open-recent?) #f) + (define/override (file-menu:create-new?) #f) + (define/override (file-menu:create-save?) #f) + (define/override (file-menu:create-revert?) #f) + (field (ok-to-close? #f)) (public set-ok-to-close) (define (set-ok-to-close ok?) (set! ok-to-close? #t)) @@ -45,15 +47,15 @@ (ask-yes-or-no (string-constant cancel-bug-report?) (string-constant are-you-sure-cancel-bug-report?) this))) - + (super-make-object title))) - - + + (define (help-desk:report-bug) (define bug-frame (instantiate bug-frame% () (title (string-constant bug-report-form)))) (define single (new panel:single% (parent (send bug-frame get-area-container)))) (define outermost-panel (make-object vertical-panel% single)) - + (define response-panel (new vertical-panel% (parent single))) (define response-text (new (html-text-mixin text%) (auto-wrap #t))) (define response-ec (new editor-canvas% (parent response-panel) (editor response-text)))