diff --git a/drracket/help/bug-report.rkt b/drracket/help/bug-report.rkt
index 24a55fcaa..e0aef91ea 100644
--- a/drracket/help/bug-report.rkt
+++ b/drracket/help/bug-report.rkt
@@ -1,13 +1,13 @@
#lang racket/base
-(require string-constants
- net/head
- racket/gui/base
+(require browser/htmltext
framework
+ net/head
+ net/uri-codec
+ net/url
racket/class
+ racket/gui/base
racket/port
- net/url
- net/uri-codec
- browser/htmltext
+ string-constants
"private/bug-report-controls.rkt"
"private/buginfo.rkt"
"private/save-bug-report.rkt")
@@ -49,10 +49,10 @@
[(null? open-frames)
(report-bug/new-frame this-bug-id frame-mixin)]
[else
- (let ([open-frame (car open-frames)])
- (if (= (send open-frame get-bug-id) this-bug-id)
- (send open-frame show #t)
- (loop (cdr open-frames))))]))]
+ (define open-frame (car open-frames))
+ (if (= (send open-frame get-bug-id) this-bug-id)
+ (send open-frame show #t)
+ (loop (cdr open-frames)))]))]
[else
(report-bug/new-frame this-bug-id frame-mixin)]))
@@ -259,24 +259,25 @@
[else #f]))
;; skip HTTP headers
(regexp-match-positions #rx"\r?\n\r?\n" port)
- (if error?
- ;; error status => show as error
- (begin (with-pending-text
- (λ ()
- (send pending-text erase)
- (render-html-to-text port pending-text #t #f)))
- (channel-put exn-chan #f)) ; #f = "already rendered"
+ (cond
+ [error?
+ ;; error status => show as error
+ (with-pending-text (λ ()
+ (send pending-text erase)
+ (render-html-to-text port pending-text #t #f)))
+ (channel-put exn-chan #f)] ; #f = "already rendered"
;; (hopefully) a good result
- (let ([response-text (new html-text%)])
- (render-html-to-text port response-text #t #f)
- (send response-text auto-wrap #t)
- (send response-text lock #t)
- (channel-put response-chan response-text))))))))))
+ [else
+ (define response-text (new html-text%))
+ (render-html-to-text port response-text #t #f)
+ (send response-text auto-wrap #t)
+ (send response-text lock #t)
+ (channel-put response-chan response-text)]))))))))
(define (render-error to-render)
(cond
[(string? to-render)
- (let ([str (string-append "\n\nERROR:\n"to-render"\n
\n")])
- (render-error (open-input-string str)))]
+ (define str (string-append "\n\nERROR:\n" to-render "\n
\n"))
+ (render-error (open-input-string str))]
[(exn? to-render)
(define sp (open-output-string))
(fprintf sp "~a\n" (exn-message to-render))
diff --git a/drracket/help/private/bug-report-controls.rkt b/drracket/help/private/bug-report-controls.rkt
index 88eaaa749..d5abea85c 100644
--- a/drracket/help/private/bug-report-controls.rkt
+++ b/drracket/help/private/bug-report-controls.rkt
@@ -1,26 +1,21 @@
#lang racket/base
-(require racket/gui/base
+(require (for-syntax racket/base
+ racket/list)
+ framework
+ pkg
racket/class
racket/contract
+ racket/gui/base
racket/pretty
- string-constants/string-constant
setup/dirs
setup/link
- framework
- pkg
- (for-syntax racket/base
- racket/list)
+ string-constants/string-constant
"buginfo.rkt"
"save-bug-report.rkt")
-(provide/contract
- [add-bug-report-controls
- (-> (is-a?/c area-container<%>)
- saved-report?
- (-> any)
- (-> any)
- (-> any)
- any)])
+(provide (contract-out
+ [add-bug-report-controls
+ (-> (is-a?/c area-container<%>) saved-report? (-> any) (-> any) (-> any) any)]))
(define (add-bug-report-controls compose-panel init-bug-report ok cancel close-and-save)
(define top-panel (make-object vertical-panel% compose-panel))
@@ -61,10 +56,9 @@
(define (align-labels)
(send synthesized-dialog reflow-container)
(send compose-panel reflow-container)
- (let ([width (apply max (map (lambda (x) (send (car (send x get-children)) get-width))
- lps))])
- (for ([x (in-list lps)])
- (send x min-width width))))
+ (define width (apply max (map (lambda (x) (send (car (send x get-children)) get-width)) lps)))
+ (for ([x (in-list lps)])
+ (send x min-width width)))
(define name
(build/label
@@ -151,24 +145,19 @@
(build/label
label
(lambda (panel)
- (let* ([text (new (editor:standard-style-list-mixin
- (editor:keymap-mixin
- (if key
- save-text%
- text:basic%))))]
- [canvas (new canvas:basic%
- (style '(hide-hscroll))
- (parent panel)
- (editor text))])
- (send text set-paste-text-only #t)
- (send text auto-wrap #t)
- (send text set-max-undo-history 'forever)
- (send text set-styles-fixed #t)
- (when key
- (send text insert (saved-report-lookup init-bug-report key))
- (send text set-position 0 0)
- (send text initialized))
- canvas))
+ (define text
+ (new (editor:standard-style-list-mixin
+ (editor:keymap-mixin (if key save-text% text:basic%)))))
+ (define canvas (new canvas:basic% (style '(hide-hscroll)) (parent panel) (editor text)))
+ (send text set-paste-text-only #t)
+ (send text auto-wrap #t)
+ (send text set-max-undo-history 'forever)
+ (send text set-styles-fixed #t)
+ (when key
+ (send text insert (saved-report-lookup init-bug-report key))
+ (send text set-position 0 0)
+ (send text initialized))
+ canvas)
#t
#:stretch? stretch?
#:top-panel top-panel
@@ -253,28 +242,24 @@
(send synthesized-dialog reflow-container) ;; help out the editor by resizing the container to a reasonable width (and thus make word-wrapping easier)
(define extras
- (map (lambda (bri)
- (let ([label (bri-label bri)])
- (cons
- label
- (build/label
- label
- (lambda (panel)
- (let ([field
- (keymap:call/text-keymap-initializer
- (lambda ()
- (new text-field%
- [label #f]
- [parent panel]
- [callback void]
- [init-value ""]
- [min-height (bri-min-height bri)])))])
- (send field set-value (bri-value bri))
- (send (send field get-editor) set-position 0)
- field))
- #f
- #:top-panel synthesized-panel))))
- (get-bug-report-infos)))
+ (for/list ([bri (in-list (get-bug-report-infos))])
+ (define label (bri-label bri))
+ (cons label
+ (build/label label
+ (lambda (panel)
+ (let ([field (keymap:call/text-keymap-initializer
+ (lambda ()
+ (new text-field%
+ [label #f]
+ [parent panel]
+ [callback void]
+ [init-value ""]
+ [min-height (bri-min-height bri)])))])
+ (send field set-value (bri-value bri))
+ (send (send field get-editor) set-position 0)
+ field))
+ #f
+ #:top-panel synthesized-panel))))
(define still-save? #t)
(define (no-more-saving) (set! still-save? #f))
@@ -308,9 +293,8 @@
(cons 'description (get-content description))
(cons 'how-to-repeat (get-content reproduce))
(cons 'platform (get-environment)))
- (map (λ (bri) (cons (string->symbol (format "~a" (bri-label bri)))
- (bri-value bri)))
- (get-bug-report-infos))))
+ (for/list ([bri (in-list (get-bug-report-infos))])
+ (cons (string->symbol (format "~a" (bri-label bri))) (bri-value bri)))))
(define (get-environment)
(string-append (send environment get-value)
@@ -324,28 +308,15 @@
"\n"
(apply
string-append
- (map (lambda (extra)
- (format "~a: ~a\n"
- (car extra)
- (send (cdr extra) get-value)))
- extras))))
+ (for/list ([extra (in-list extras)])
+ (format "~a: ~a\n" (car extra) (send (cdr extra) get-value))))))
(define (get-content canvas)
(define t (send canvas get-editor))
(send t get-text 0 (send t last-position)))
- (define (set-content canvas str)
- (define t (send canvas get-editor))
- (send t begin-edit-sequence)
- (send t erase)
- (send t insert str)
- (send t end-edit-sequence))
-
(define (compose-view-focus)
- (send (if (string=? "" (preferences:get 'drracket:full-name))
- name
- summary)
- focus))
+ (send (if (string=? "" (preferences:get 'drracket:full-name)) name summary) focus))
(define button-panel
(new horizontal-panel% [parent compose-panel]
@@ -368,34 +339,28 @@
(define (sanity-checking)
- (let ([no-value?
- (lambda (f)
- (cond
- [(is-a? f editor-canvas%)
- (= 0 (send (send f get-editor) last-position))]
- [else (string=? "" (send f get-value))]))])
- (let/ec done-checking
- (for-each
- (lambda (field field-name)
- (when (no-value? field)
- (message-box (string-constant illegal-bug-report)
- (format (string-constant pls-fill-in-field) field-name))
- (done-checking #f)))
- (list name summary)
- (list (string-constant bug-report-field-name)
- (string-constant bug-report-field-summary)))
-
- (when (and (no-value? description)
- (no-value? reproduce))
- (message-box (string-constant illegal-bug-report)
- (string-constant pls-fill-in-either-description-or-reproduce))
- (done-checking #f))
-
- (unless (regexp-match #rx"@" (or (preferences:get 'drracket:email) ""))
- (message-box (string-constant illegal-bug-report)
- (string-constant malformed-email-address))
- (done-checking #f))
- (done-checking #t))))
+ (define (no-value? f)
+ (cond
+ [(is-a? f editor-canvas%) (= 0 (send (send f get-editor) last-position))]
+ [else (string=? "" (send f get-value))]))
+ (let/ec done-checking
+ (for-each (lambda (field field-name)
+ (when (no-value? field)
+ (message-box (string-constant illegal-bug-report)
+ (format (string-constant pls-fill-in-field) field-name))
+ (done-checking #f)))
+ (list name summary)
+ (list (string-constant bug-report-field-name)
+ (string-constant bug-report-field-summary)))
+ (when (and (no-value? description) (no-value? reproduce))
+ (message-box (string-constant illegal-bug-report)
+ (string-constant pls-fill-in-either-description-or-reproduce))
+ (done-checking #f))
+ (unless (regexp-match #rx"@" (or (preferences:get 'drracket:email) ""))
+ (message-box (string-constant illegal-bug-report)
+ (string-constant malformed-email-address))
+ (done-checking #f))
+ (done-checking #t)))
(send version-tf set-value (format "~a" (version:version)))
diff --git a/drracket/help/private/save-bug-report.rkt b/drracket/help/private/save-bug-report.rkt
index d5733cd80..c8f5064f3 100644
--- a/drracket/help/private/save-bug-report.rkt
+++ b/drracket/help/private/save-bug-report.rkt
@@ -1,10 +1,10 @@
#lang racket/base
-(require racket/match
+(require framework/preferences
racket/contract
- racket/serialize
racket/list
- framework/preferences)
+ racket/match
+ racket/serialize)
(define bug-classes '(("software bug" "sw-bug")
("documentation bug" "doc-bug")
@@ -182,18 +182,18 @@
saved-report?
default-severity
default-class)
-(provide/contract
- [register-new-bug-id (-> saved-report?)]
- [lookup-bug-report (-> number? saved-report?)]
- [saved-report-lookup (-> saved-report? (apply or/c valid-keys) string?)]
- [saved-report-id (-> saved-report? number?)]
- [save-bug-report (-> number?
- #:severity (apply or/c bug-severities)
- #:class (apply or/c (map car bug-classes))
- #:subject string?
- #:description string?
- #:how-to-repeat string?
- void?)]
- [unsave-bug-report (-> number? void?)]
- [saved-bug-report-titles/ids (-> (listof brinfo?))]
- [discard-all-except (-> (-> number? boolean?) void?)])
+(provide (contract-out [register-new-bug-id (-> saved-report?)]
+ [lookup-bug-report (-> number? saved-report?)]
+ [saved-report-lookup (-> saved-report? (apply or/c valid-keys) string?)]
+ [saved-report-id (-> saved-report? number?)]
+ [save-bug-report
+ (-> number?
+ #:severity (apply or/c bug-severities)
+ #:class (apply or/c (map car bug-classes))
+ #:subject string?
+ #:description string?
+ #:how-to-repeat string?
+ void?)]
+ [unsave-bug-report (-> number? void?)]
+ [saved-bug-report-titles/ids (-> (listof brinfo?))]
+ [discard-all-except (-> (-> number? boolean?) void?)]))