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

Add more items to the frameless help menu

Browse Source 
closes PR 13262
This commit is contained in:
Robby Findler 2012-11-17 13:07:19 -06:00
parent aa83f80d64
commit fda9d211b7
1 changed files with 115 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

168
collects/drracket/private/frame.rkt
View File

@ -163,78 +163,7 @@
(define/public (get-additional-important-urls) '()) (define/public (get-additional-important-urls) '())
(define/override (help-menu:after-about menu) (define/override (help-menu:after-about menu)
(drracket:app:add-important-urls-to-help-menu (drracket-help-menu:after-about menu this))
menu
(get-additional-important-urls))
(new menu-item%
[label (string-constant bug-report-submit-menu-item)]
[parent menu]
[callback
(λ (x y)
(define saved (saved-bug-report-titles/ids))
(cond
[(null? saved)
(help-desk:report-bug #f #:frame-mixin basics-mixin)]
[else
(define which #f)
(define (done the-one)
(set! which the-one)
(send dlg show #f))
(define dlg (new dialog%
[label (string-constant drscheme)]
[parent this]))
(define btn1 (new button%
[parent dlg]
[label (string-constant new-bug-report)]
[callback (λ (x y) (done #f))]))
(new message% [parent dlg] [label (string-constant saved-unsubmitted-bug-reports)])
(define btns
(cons btn1
(for/list ([a-brinfo (in-list saved)])
(new button%
[parent dlg]
[label (brinfo-title a-brinfo)]
[callback
(λ (x y) (done (brinfo-id a-brinfo)))]))))
(define width (apply max (map (λ (x) (let-values ([(w h) (send x get-client-size)]) w))
btns)))
(for ([x (in-list btns)])
(send x min-width width))
(send btn1 focus)
(send dlg show #t)
(help-desk:report-bug which #:frame-mixin basics-mixin)]))])
(new menu%
[label (string-constant saved-bug-reports-menu-item)]
[parent menu]
[demand-callback
(let ([last-time (gensym)]) ;; a unique thing to guarantee the menu is built the first time
(λ (saved-bug-reports-menu)
(define this-time (saved-bug-report-titles/ids))
(unless (equal? last-time this-time)
(set! last-time this-time)
(for ([x (in-list (send saved-bug-reports-menu get-items))])
(send x delete))
(cond
[(null? this-time)
(send (new menu-item%
[parent saved-bug-reports-menu]
[label (string-constant no-saved-bug-reports)]
[callback void])
enable #f)]
[else
(for ([a-brinfo (in-list this-time)])
(new menu-item%
[parent saved-bug-reports-menu]
[label (brinfo-title a-brinfo)]
[callback
(λ (x y)
(help-desk:report-bug (brinfo-id a-brinfo) #:frame-mixin basics-mixin))]))
(new separator-menu-item% [parent saved-bug-reports-menu])
(new menu-item%
[parent saved-bug-reports-menu]
[label (string-constant disacard-all-saved-bug-reports)]
[callback (λ (x y) (discard-all-saved-bug-reports))])]))))])
(drracket:app:add-language-items-to-help-menu menu))
(define/override (file-menu:new-string) (string-constant new-menu-item)) (define/override (file-menu:new-string) (string-constant new-menu-item))
(define/override (file-menu:open-string) (string-constant open-menu-item)) (define/override (file-menu:open-string) (string-constant open-menu-item))
@ -713,13 +642,13 @@
(define (create-root-menubar) (define (create-root-menubar)
(let* ([mb (new menu-bar% (parent 'root))] (define mb (new menu-bar% (parent 'root)))
[file-menu (new menu% (define file-menu (new menu%
(label (string-constant file-menu)) (label (string-constant file-menu))
(parent mb))] (parent mb)))
[help-menu (new menu% (define help-menu (new menu%
(label (string-constant help-menu)) (label (string-constant help-menu))
(parent mb))]) (parent mb)))
(new menu-item% (new menu-item%
(label (string-constant new-menu-item)) (label (string-constant new-menu-item))
(parent file-menu) (parent file-menu)
@ -742,12 +671,12 @@
(demand-callback (demand-callback
(λ (menu) (λ (menu)
(handler:install-recent-items menu)))) (handler:install-recent-items menu))))
(instantiate menu-item% () (new menu-item%
(label (string-constant mfs-multi-file-search-menu-item)) [label (string-constant mfs-multi-file-search-menu-item)]
(parent file-menu) [parent file-menu]
(callback [callback
(λ (_1 _2) (λ (_1 _2)
(drracket:multi-file-search:multi-file-search)))) (drracket:multi-file-search:multi-file-search))])
(unless (current-eventspace-has-standard-menus?) (unless (current-eventspace-has-standard-menus?)
(new separator-menu-item% (parent file-menu)) (new separator-menu-item% (parent file-menu))
(new menu-item% (new menu-item%
@ -759,7 +688,8 @@
(when (exit:user-oks-exit) (when (exit:user-oks-exit)
(exit:exit)) (exit:exit))
#t)))) #t))))
(make-help-desk-menu-item help-menu))) (make-help-desk-menu-item help-menu)
(drracket-help-menu:after-about help-menu #f))
(define (make-help-desk-menu-item help-menu) (define (make-help-desk-menu-item help-menu)
(define (docs-menu-item label) (define (docs-menu-item label)
@ -770,3 +700,75 @@
(docs-menu-item (string-constant racket-documentation)) (docs-menu-item (string-constant racket-documentation))
(new separator-menu-item% [parent help-menu]) (new separator-menu-item% [parent help-menu])
(docs-menu-item (string-constant help-desk))) (docs-menu-item (string-constant help-desk)))
(define (drracket-help-menu:after-about menu dlg-parent)
(drracket:app:add-important-urls-to-help-menu menu '())
(new menu-item%
[label (string-constant bug-report-submit-menu-item)]
[parent menu]
[callback
(λ (x y)
(define saved (saved-bug-report-titles/ids))
(cond
[(null? saved)
(help-desk:report-bug #f #:frame-mixin basics-mixin)]
[else
(define which #f)
(define (done the-one)
(set! which the-one)
(send dlg show #f))
(define dlg (new dialog%
[label (string-constant drscheme)]
[parent dlg-parent]))
(define btn1 (new button%
[parent dlg]
[label (string-constant new-bug-report)]
[callback (λ (x y) (done #f))]))
(new message% [parent dlg] [label (string-constant saved-unsubmitted-bug-reports)])
(define btns
(cons btn1
(for/list ([a-brinfo (in-list saved)])
(new button%
[parent dlg]
[label (brinfo-title a-brinfo)]
[callback
(λ (x y) (done (brinfo-id a-brinfo)))]))))
(define width (apply max (map (λ (x) (let-values ([(w h) (send x get-client-size)]) w))
btns)))
(for ([x (in-list btns)])
(send x min-width width))
(send btn1 focus)
(send dlg show #t)
(help-desk:report-bug which #:frame-mixin basics-mixin)]))])
(new menu%
[label (string-constant saved-bug-reports-menu-item)]
[parent menu]
[demand-callback
(let ([last-time (gensym)]) ;; a unique thing to guarantee the menu is built the first time
(λ (saved-bug-reports-menu)
(define this-time (saved-bug-report-titles/ids))
(unless (equal? last-time this-time)
(set! last-time this-time)
(for ([x (in-list (send saved-bug-reports-menu get-items))])
(send x delete))
(cond
[(null? this-time)
(send (new menu-item%
[parent saved-bug-reports-menu]
[label (string-constant no-saved-bug-reports)]
[callback void])
enable #f)]
[else
(for ([a-brinfo (in-list this-time)])
(new menu-item%
[parent saved-bug-reports-menu]
[label (brinfo-title a-brinfo)]
[callback
(λ (x y)
(help-desk:report-bug (brinfo-id a-brinfo) #:frame-mixin basics-mixin))]))
(new separator-menu-item% [parent saved-bug-reports-menu])
(new menu-item%
[parent saved-bug-reports-menu]
[label (string-constant disacard-all-saved-bug-reports)]
[callback (λ (x y) (discard-all-saved-bug-reports))])]))))])
(drracket:app:add-language-items-to-help-menu menu))