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

change bug-report form to use a working qp encoding

Browse Source 
svn: r6561
This commit is contained in:
Matthew Flatt 2007-06-10 01:04:56 +00:00
parent 732569c39d
commit 753c6bf6cc
1 changed files with 12 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/help/bug-report.ss
View File

@ -11,6 +11,7 @@
(lib "uri-codec.ss" "net")
(lib "htmltext.ss" "browser")
(lib "dirs.ss" "setup")
(lib "qp.ss" "net")
"private/buginfo.ss"
"private/manuals.ss")
@ -340,19 +341,19 @@
(define (get-query)
(list (cons 'help-desk "true")
(cons 'replyto (preferences:get 'drscheme:email))
(cons 'originator (qp-encode (preferences:get 'drscheme:full-name)))
(cons 'subject (qp-encode (send summary get-value)))
(cons 'severity (qp-encode (send severity get-string-selection)))
(cons 'originator (qp-encode-string (preferences:get 'drscheme:full-name)))
(cons 'subject (qp-encode-string (send summary get-value)))
(cons 'severity (qp-encode-string (send severity get-string-selection)))
(cons 'class (translate-class (send bug-class get-string-selection)))
(cons 'release (qp-encode (send version get-value)))
(cons 'description (qp-encode
(cons 'release (qp-encode-string (send version get-value)))
(cons 'description (qp-encode-string
(apply string-append (map (lambda (x) (string-append x "\n"))
(get-strings description)))))
(cons 'how-to-repeat (qp-encode
(cons 'how-to-repeat (qp-encode-string
(apply string-append
(map (lambda (x) (string-append x "\n"))
(get-strings reproduce)))))
(cons 'platform (qp-encode (get-environment)))))
(cons 'platform (qp-encode-string (get-environment)))))
(define (get-environment)
(string-append (send environment get-value)
@ -427,47 +428,10 @@
;; qp-encode : string -> string
;; 'pre' escapes bytes that would be turned into non 7-bit values by utf8 encoding
;; so that later utf-8 encoding will just leave them alone .... (ugh)
;; also note that the encoding isn't quite quoted printable, since this code
;; cannot ensure that the entire bug report has short lines.
;; It doesn't do any soft line breaking, in fact.
(define (qp-encode str)
(bytes->string/utf-8 (qp-encode/bytes (string->bytes/utf-8 str))))
(define (qp-encode/bytes bytes)
(let loop ([blst (bytes->list bytes)]
[acc null])
(cond
[(null? blst) (list->bytes (reverse! acc))]
[else
(let ([b (car blst)])
(cond
[(<= 9 b 32)
(if (or (null? (cdr blst))
(not (equal? #\newline (cadr blst))))
(loop (cdr blst) (cons b acc))
(loop (cdr blst)
(add-qp-bytes b acc)))]
[(and (<= 33 b 126) (not (= b 61)))
(loop (cdr blst)
(cons b acc))]
[else
(loop (cdr blst)
(add-qp-bytes b acc))]))])))
(define (add-qp-bytes b acc)
(append (reverse (bytes->list (string->bytes/utf-8 (qp-encode/byte b))))
acc))
(define (qp-encode/byte b)
(format "=~a~a"
(hex-num->digit (quotient b 16))
(hex-num->digit (modulo b 16))))
(define (hex-num->digit d)
(cond
[(<= d 9) d]
[else (integer->char (+ (char->integer #\A) d -9))]))
(define (qp-encode-string str)
(bytes->string/utf-8 (qp-encode (string->bytes/utf-8 str))))
(define (get-strings canvas)
(let ([t (send canvas get-editor)])
(let loop ([n 0])