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

does some quoted printable encodings

Browse Source 
svn: r6546
This commit is contained in:
Robby Findler 2007-06-08 14:49:56 +00:00
parent 63ce7b93fb
commit 860ee82a67
1 changed files with 57 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -340,16 +340,19 @@
(define (get-query)
(list (cons 'help-desk "true")
(cons 'replyto (preferences:get 'drscheme:email))
(cons 'originator (preferences:get 'drscheme:full-name))
(cons 'subject (send summary get-value))
(cons 'severity (send severity get-string-selection))
(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 'class (translate-class (send bug-class get-string-selection)))
(cons 'release (send version get-value))
(cons 'description (apply string-append (map (lambda (x) (string-append x "\n"))
(get-strings description))))
(cons 'how-to-repeat (apply string-append (map (lambda (x) (string-append x "\n"))
(get-strings reproduce))))
(cons 'platform (get-environment))))
(cons 'release (qp-encode (send version get-value)))
(cons 'description (qp-encode
(apply string-append (map (lambda (x) (string-append x "\n"))
(get-strings description)))))
(cons 'how-to-repeat (qp-encode
(apply string-append
(map (lambda (x) (string-append x "\n"))
(get-strings reproduce)))))
(cons 'platform (qp-encode (get-environment)))))
(define (get-environment)
(string-append (send environment get-value)
@ -421,6 +424,50 @@
(send response-abort enable #t)
(switch-to-response-view)))
;; 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 (get-strings canvas)
(let ([t (send canvas get-editor)])
(let loop ([n 0])