2043b4ad6f
- show discard-all-bug-reports menu item as long as there is at least one bug report - move the close-and-save button to the left-hand side of the dialog - ask about discarding bug reports when clicking the close box - working dealing with empty bug reports - the 'finished' stage of the bug report form sets the focus to the close button closes PR 11644 closes PR 11645 closes PR 11638 closes PR 11640
202 lines
6.3 KiB
Racket
202 lines
6.3 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/match
|
|
racket/contract
|
|
racket/serialize
|
|
racket/list
|
|
framework/preferences)
|
|
|
|
(define bug-classes '(("software bug" "sw-bug")
|
|
("documentation bug" "doc-bug")
|
|
("change request" "change-request")
|
|
("support" "support")))
|
|
|
|
(define (translate-class class)
|
|
(cadr (assoc class bug-classes)))
|
|
|
|
(define bug-severities '("critical" "serious" "non-critical"))
|
|
|
|
(define (with-pref func #:rewrite? rewrite?)
|
|
(define old (preferences:get 'drracket:unfinished-bug-reports))
|
|
(define ans (func old))
|
|
(if rewrite?
|
|
(preferences:set 'drracket:unfinished-bug-reports ans)
|
|
ans))
|
|
|
|
(define (discard-all-except f)
|
|
(with-pref
|
|
#:rewrite? #t
|
|
(λ (exp)
|
|
(filter (λ (saved-report) (f (saved-report-id saved-report)))
|
|
exp))))
|
|
|
|
(define valid-keys (sort '(severity
|
|
class
|
|
subject
|
|
description
|
|
how-to-repeat)
|
|
string<=?
|
|
#:key symbol->string))
|
|
|
|
;; id : number
|
|
;; open? : boolean?
|
|
;; table : (listof (list sym string?))
|
|
;; (the above are only an upper bound on the constraints here;
|
|
;; see validate for more info)
|
|
(serializable-struct saved-report (id table) #:transparent)
|
|
|
|
(define (blank-bug-form id)
|
|
(saved-report id
|
|
(for/list ([key (in-list valid-keys)])
|
|
(list key
|
|
(case key
|
|
[(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
|
|
(define (valid? saved-reports)
|
|
(cond
|
|
[(list? saved-reports)
|
|
(and (for/and ([saved-report (in-list saved-reports)])
|
|
(validate-single saved-report))
|
|
(no-dups (map saved-report-id saved-reports)))]
|
|
[else #f]))
|
|
|
|
(define (no-dups l) (equal? l (remove-duplicates l)))
|
|
|
|
(define (validate-single a-saved-report)
|
|
(match a-saved-report
|
|
[(struct saved-report ((? number?)
|
|
(list (list (? symbol? keys) vals) ...)))
|
|
(and (equal? (sort keys string<=? #:key symbol->string)
|
|
valid-keys)
|
|
(for/and ([key (in-list keys)]
|
|
[val (in-list vals)])
|
|
(case key
|
|
[(class) (member val (map car bug-classes))]
|
|
[(severity) (member val bug-severities)]
|
|
[else (string? val)])))]
|
|
[else #f]))
|
|
|
|
(define (register-new-bug-id)
|
|
(define ans #f)
|
|
(with-pref
|
|
#:rewrite? #t
|
|
(λ (bug-reports)
|
|
(define ids (map saved-report-id bug-reports))
|
|
(define new-id
|
|
(let loop ([i 0])
|
|
(cond
|
|
[(member i ids)
|
|
(loop (+ i 1))]
|
|
[else
|
|
i])))
|
|
(set! ans (blank-bug-form new-id))
|
|
(cons ans bug-reports)))
|
|
ans)
|
|
|
|
;; title : label-string?
|
|
;; id : number?
|
|
(struct brinfo (title id) #:transparent)
|
|
|
|
(define (saved-bug-report-titles/ids)
|
|
(with-pref
|
|
#:rewrite? #f
|
|
(λ (x)
|
|
(for/list ([a-saved-report (in-list x)])
|
|
(define assoc-l (saved-report-table a-saved-report))
|
|
(define subj-p (assoc 'subject assoc-l))
|
|
(define title (cadr subj-p))
|
|
(brinfo (if (string=? title "")
|
|
"<<no title>>"
|
|
(trim-to-200 (regexp-replace* #rx"&" title "&&")))
|
|
(saved-report-id a-saved-report))))))
|
|
|
|
(define (trim-to-200 str)
|
|
(cond
|
|
[(<= (string-length str) 200)
|
|
str]
|
|
[else
|
|
(define len (string-length str))
|
|
(define spacer " ... ")
|
|
(string-append
|
|
(substring str 0 100)
|
|
spacer
|
|
(substring str (+ (- len 100) (string-length spacer)) len))]))
|
|
|
|
(define (lookup-bug-report id)
|
|
(or (with-pref
|
|
#:rewrite? #f
|
|
(λ (exp)
|
|
(ormap (λ (x) (and (equal? id (saved-report-id x)) x))
|
|
exp)))
|
|
(register-new-bug-id)))
|
|
|
|
(define (saved-report-lookup a-saved-report key)
|
|
(cadr (assoc key (saved-report-table a-saved-report))))
|
|
|
|
(define (save-bug-report id
|
|
#:severity severity
|
|
#:class class
|
|
#:subject subject
|
|
#:description description
|
|
#:how-to-repeat how-to-repeat)
|
|
(with-pref
|
|
#:rewrite? #t
|
|
(λ (reports)
|
|
(cons
|
|
(saved-report id (list (list 'severity severity)
|
|
(list 'class class)
|
|
(list 'subject subject)
|
|
(list 'description description)
|
|
(list 'how-to-repeat how-to-repeat)))
|
|
(filter (λ (saved-report)
|
|
(not (equal? id (saved-report-id saved-report))))
|
|
reports)))))
|
|
|
|
|
|
(define (unsave-bug-report id)
|
|
(with-pref
|
|
#:rewrite? #t
|
|
(λ (reports)
|
|
(filter (λ (saved-report) (not (equal? id (saved-report-id saved-report))))
|
|
reports))))
|
|
|
|
(preferences:set-default 'drracket:unfinished-bug-reports
|
|
'()
|
|
valid?)
|
|
(preferences:set-un/marshall 'drracket:unfinished-bug-reports
|
|
serialize
|
|
(λ (x)
|
|
(with-handlers ((exn:fail? (λ (exn) '())))
|
|
(deserialize x))))
|
|
|
|
(provide bug-severities
|
|
bug-classes
|
|
translate-class
|
|
(struct-out brinfo)
|
|
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?)])
|