diff --git a/collects/drracket/private/frame.rkt b/collects/drracket/private/frame.rkt index 4ea4a4b1b5..f086f4df9c 100644 --- a/collects/drracket/private/frame.rkt +++ b/collects/drracket/private/frame.rkt @@ -208,12 +208,11 @@ [callback void]) enable #f)] [else - (unless (null? (cdr this-time)) - (new menu-item% - [parent saved-bug-reports-menu] - [label (string-constant disacard-all-saved-bug-reports)] - [callback (λ (x y) (discard-all-saved-bug-reports))]) - (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))]) + (new separator-menu-item% [parent saved-bug-reports-menu]) (for ([a-brinfo (in-list this-time)]) (new menu-item% [parent saved-bug-reports-menu] diff --git a/collects/help/bug-report.rkt b/collects/help/bug-report.rkt index b60cfa1b31..2e1bf5af9c 100644 --- a/collects/help/bug-report.rkt +++ b/collects/help/bug-report.rkt @@ -53,6 +53,35 @@ (define editing? #t) (define/public (no-longer-editing) (set! editing? #f)) + (define close-box-clicked? #t) + (define/public (set-close-box-not-clicked) (set! close-box-clicked? #f)) + (define/augment (can-close?) + (cond + [close-box-clicked? + (cond + [(empty-bug-report?) + (no-more-saving) + (unsave-bug-report bug-id) + (set! editing? #f)] + [else + (define user-choice + (message-box/custom (string-constant cancel-bug-report?) + (string-constant do-you-want-to-discard-or-save-this-bug-report) + (string-constant save) + (string-constant cancel) + (string-constant discard) + this + '(default=1) + 1)) + (case user-choice + [(1) #t] ;; saving happens automatically + [(2) #f] + [(3) + (no-more-saving) + (unsave-bug-report bug-id) + (set! editing? #f) + #t])])] + [else #t])) (define/augment (on-close) (inner (void) on-close) (set! open-frames (remq this open-frames))) @@ -79,7 +108,7 @@ (define cancel-kill-cust #f) - (define-values (compose-view-focus get-query sanity-checking) + (define-values (compose-view-focus get-query sanity-checking no-more-saving empty-bug-report?) (add-bug-report-controls compose-panel init-bug-report (λ () (ok)) @@ -133,6 +162,7 @@ [label (string-constant close)] [callback (lambda (x y) + (send bug-frame set-close-box-not-clicked) (send bug-frame close))])) (new grow-box-spacer-pane% [parent finished-button-panel]) @@ -152,7 +182,8 @@ (define (switch-to-finished-view finished-text) (send finished-ec set-editor finished-text) (unsave-bug-report (saved-report-id init-bug-report)) - (send single active-child finished-panel)) + (send single active-child finished-panel) + (send finished-close focus)) ; send-bug-report : (-> void) ;; initiates sending the bug report and switches the GUI's mode @@ -231,13 +262,16 @@ (send-bug-report))) (define (cancel) - (when (ask-yes-or-no (string-constant cancel-bug-report?) - (string-constant are-you-sure-cancel-bug-report?) - bug-frame) + (when (or (empty-bug-report?) + (ask-yes-or-no (string-constant cancel-bug-report?) + (string-constant are-you-sure-cancel-bug-report?) + bug-frame)) (unsave-bug-report (saved-report-id init-bug-report)) + (send bug-frame set-close-box-not-clicked) (send bug-frame close))) (define (close-and-save) + (send bug-frame set-close-box-not-clicked) (send bug-frame close)) ;; Currently, the help-menu is left empty diff --git a/collects/help/private/bug-report-controls.rkt b/collects/help/private/bug-report-controls.rkt index 301730bc67..afcb38254c 100644 --- a/collects/help/private/bug-report-controls.rkt +++ b/collects/help/private/bug-report-controls.rkt @@ -260,20 +260,24 @@ #:top-panel synthesized-panel)))) (get-bug-report-infos))) - (define (save-this-bug-report) - (save-bug-report - (saved-report-id init-bug-report) - #:severity (send severity get-string-selection) - #:class (send bug-class get-string-selection) - #:subject (send summary get-value) - #:description (get-content description) - #:how-to-repeat (get-content reproduce))) + (define still-save? #t) + (define (no-more-saving) (set! still-save? #f)) + + (define (save-this-bug-report) + (when still-save? + (save-bug-report + (saved-report-id init-bug-report) + #:severity (send severity get-string-selection) + #:class (send bug-class get-string-selection) + #:subject (send summary get-value) + #:description (get-content description) + #:how-to-repeat (get-content reproduce)))) (define timer (new timer% [notify-callback save-this-bug-report] [just-once? #t])) - (define (bug-report-out-of-date) + (define (bug-report-out-of-date) (send timer stop) (send timer start 200 #t)) @@ -332,11 +336,11 @@ (make-object button% (string-constant bug-report-show-synthesized-info) button-panel (lambda x (show-synthesized-info)))) - (new horizontal-pane% (parent button-panel)) (new button% [parent button-panel] [label (string-constant close-and-save)] [callback (λ (a b) (close-and-save))]) + (new horizontal-pane% (parent button-panel)) (gui-utils:ok/cancel-buttons button-panel (λ (a b) (ok)) (λ (a b) (cancel)) @@ -401,6 +405,18 @@ (send (send collections get-editor) auto-wrap #t) (align-labels) + (define (empty-bug-report?) + (define (empty-editor? c) + (define t (send c get-editor)) + (zero? (send t last-position))) + (and (empty-editor? reproduce) + (empty-editor? description) + (empty-editor? summary) + (equal? (send severity get-selection) default-severity) + (equal? (send bug-class get-selection) default-class))) + (values compose-view-focus get-query - sanity-checking)) + sanity-checking + no-more-saving + empty-bug-report?)) diff --git a/collects/help/private/save-bug-report.rkt b/collects/help/private/save-bug-report.rkt index e31e4d8875..7bb3ec5248 100644 --- a/collects/help/private/save-bug-report.rkt +++ b/collects/help/private/save-bug-report.rkt @@ -1,13 +1,5 @@ #lang racket/base -#| - -If there are saved reports when a window opens, offer to open the saved ones. - -Put the saved things in the help menu. - -|# - (require racket/match racket/contract racket/serialize @@ -58,10 +50,13 @@ Put the saved things in the help menu. (for/list ([key (in-list valid-keys)]) (list key (case key - [(class) (car (car bug-classes))] - [(severity) (list-ref bug-severities 1)] + [(class) (car (list-ref bug-classes default-class))] + [(severity) (list-ref bug-severities default-severity)] [else ""]))))) +(define default-class 0) +(define default-severity 1) + ;; valid? : any -> boolean? ;; returns #t if the saved-reports are well formed @@ -146,7 +141,7 @@ Put the saved things in the help menu. (define (saved-report-lookup a-saved-report key) (cadr (assoc key (saved-report-table a-saved-report)))) -(define (save-bug-report id +(define (save-bug-report id #:severity severity #:class class #:subject subject @@ -164,6 +159,7 @@ Put the saved things in the help menu. (filter (λ (saved-report) (not (equal? id (saved-report-id saved-report)))) reports))))) + (define (unsave-bug-report id) (with-pref @@ -185,7 +181,9 @@ Put the saved things in the help menu. bug-classes translate-class (struct-out brinfo) - saved-report?) + saved-report? + default-severity + default-class) (provide/contract [register-new-bug-id (-> saved-report?)] [lookup-bug-report (-> number? saved-report?)] diff --git a/collects/string-constants/english-string-constants.rkt b/collects/string-constants/english-string-constants.rkt index e8c369b702..8cc6aab641 100644 --- a/collects/string-constants/english-string-constants.rkt +++ b/collects/string-constants/english-string-constants.rkt @@ -140,6 +140,9 @@ please adhere to these guidelines: (cancel-bug-report? "Cancel Bug Report?") (are-you-sure-cancel-bug-report? "Are you sure that you want to cancel sending this bug report?") + (do-you-want-to-discard-or-save-this-bug-report + "Do you want to discard or save this bug report?") + (discard "Discard") ;; a button label for a dialog box with the above question (bug-report-form "Bug Report Form") (bug-report-field-name "Name") (bug-report-field-email "Email")