summaryrefslogtreecommitdiff
path: root/email
diff options
context:
space:
mode:
authorArun Isaac2018-09-15 16:01:03 +0530
committerArun Isaac2018-09-15 16:10:15 +0530
commit54d005a0f1ff7ba5eb29d975e4f6735d24a4c972 (patch)
treed0978e56ff7392e564b176ce795819eb01e04402 /email
parenta3f62b26c559bee108eb59dc3afe9bce5d4b46cd (diff)
downloadguile-email-54d005a0f1ff7ba5eb29d975e4f6735d24a4c972.tar.gz
guile-email-54d005a0f1ff7ba5eb29d975e4f6735d24a4c972.tar.lz
guile-email-54d005a0f1ff7ba5eb29d975e4f6735d24a4c972.zip
quoted-printable: Q-encode #\? and #\_ with their ASCII values.
* email/quoted-printable.scm (%q-encoding-literal-char-set, %quoted-printable-literal-char-set): New variables. (quoted-printable-encode): Move core encoding code to ... (quoted-printable-style-encode): ... this new function. (q-encoding-decode): Call quoted-printable-style-encode with the appropriate literal-char-set instead of calling quoted-printable-encode. * tests/quoted-printable.scm (q-encoding of special characters): Add to check for this bug.
Diffstat (limited to 'email')
-rw-r--r--email/quoted-printable.scm71
1 files changed, 45 insertions, 26 deletions
diff --git a/email/quoted-printable.scm b/email/quoted-printable.scm
index d119f6a..7b88b04 100644
--- a/email/quoted-printable.scm
+++ b/email/quoted-printable.scm
@@ -53,6 +53,43 @@
(else (put-u8 out (char->integer c))
(quoted-printable-decode in out)))))))
+(define* (quoted-printable-style-encode
+ in out literal-char-set
+ #:optional (number-of-chars-left-on-this-line 76))
+ (let ((x (get-u8 in))
+ (put-into-output
+ (lambda (str)
+ (let* ((len (string-length str))
+ (break-line? (<= number-of-chars-left-on-this-line len)))
+ (put-string
+ out (string-append (if break-line? "=\n" "") str))
+ (if break-line?
+ (- 76 len)
+ (- number-of-chars-left-on-this-line len))))))
+ (unless (eof-object? x)
+ (let ((c (integer->char x)))
+ (quoted-printable-style-encode
+ in out literal-char-set
+ (put-into-output
+ (if (char-set-contains? literal-char-set c)
+ (string c)
+ (format #f "=~:@(~2,'0x~)" x))))))))
+
+;; Character set of characters to be represented by themselves in
+;; quoted-printable encoding
+(define %quoted-printable-literal-char-set
+ (char-set-delete
+ (ucs-range->char-set (char->integer #\space)
+ (char->integer #\delete))
+ #\=))
+
+;; Character set of characters to be represented by themselves in Q
+;; encoding
+(define %q-encoding-literal-char-set
+ (char-set-delete
+ %quoted-printable-literal-char-set
+ #\? #\_))
+
(define quoted-printable-encode
(match-lambda*
(((? bytevector? bv))
@@ -62,31 +99,8 @@
(call-with-output-string
(cut quoted-printable-encode in <>)))
(((? port? in) (? port? out))
- (quoted-printable-encode in out 76))
- (((? port? in) (? port? out) (? integer? number-of-chars-left-on-this-line))
- (let ((x (get-u8 in))
- (put-into-output
- (lambda (str)
- (let* ((len (string-length str))
- (break-line? (<= number-of-chars-left-on-this-line len)))
- (put-string
- out (string-append (if break-line? "=\n" "") str))
- (if break-line?
- (- 76 len)
- (- number-of-chars-left-on-this-line len))))))
- (unless (eof-object? x)
- (let ((c (integer->char x)))
- (quoted-printable-encode
- in out
- (put-into-output
- (if (char-set-contains?
- (char-set-delete
- (ucs-range->char-set (char->integer #\space)
- (char->integer #\delete))
- #\=)
- c)
- (string c)
- (format #f "=~:@(~2,'0x~)" x))))))))))
+ (quoted-printable-style-encode
+ in out %quoted-printable-literal-char-set))))
(define (q-encoding-decode str)
(quoted-printable-decode
@@ -99,4 +113,9 @@
(string-map
(lambda (c)
(if (char=? c #\Space) #\_ c))
- (quoted-printable-encode bv)))
+ (call-with-port
+ (open-bytevector-input-port bv)
+ (lambda (in)
+ (call-with-output-string
+ (cut quoted-printable-style-encode in <>
+ %q-encoding-literal-char-set))))))