aboutsummaryrefslogtreecommitdiff
path: root/email
diff options
context:
space:
mode:
authorArun Isaac2018-09-12 17:25:45 +0530
committerArun Isaac2018-09-12 17:25:45 +0530
commit959941b87c2e7ba732cae8ad1943432dfba83427 (patch)
tree5f55c80b01d6c73e027b7cf8b2b63aaeb142ddd9 /email
parentdc63650fc9a1617933d7076961a52408ba0d54fd (diff)
downloadguile-email-959941b87c2e7ba732cae8ad1943432dfba83427.tar.gz
guile-email-959941b87c2e7ba732cae8ad1943432dfba83427.tar.lz
guile-email-959941b87c2e7ba732cae8ad1943432dfba83427.zip
quoted-printable: Add quoted-printable-encode.
* email/quoted-printable.scm (quoted-printable-encode): New function. * tests/quoted-printable.scm (quoted-printable wikipedia example): Rename to ... (quoted-printable wikipedia example: decoding): ... this. (quoted-printable wikipedia example: encoding, quoted-printable wikipedia example: encoded output should not be more than 76 columns wide): New tests.
Diffstat (limited to 'email')
-rw-r--r--email/quoted-printable.scm33
1 files changed, 33 insertions, 0 deletions
diff --git a/email/quoted-printable.scm b/email/quoted-printable.scm
index 317bf81..d084a7e 100644
--- a/email/quoted-printable.scm
+++ b/email/quoted-printable.scm
@@ -19,8 +19,11 @@
(define-module (email quoted-printable)
#:use-module (rnrs)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:use-module (srfi srfi-26)
#:export (quoted-printable-decode
+ quoted-printable-encode
q-encoding-decode))
;; TODO: Error out on invalid quoted-printable input
@@ -49,6 +52,36 @@
(else (put-u8 out (char->integer c))
(quoted-printable-decode in out)))))))
+(define quoted-printable-encode
+ (match-lambda*
+ (((? bytevector? bv))
+ (call-with-port (open-bytevector-input-port bv)
+ quoted-printable-encode))
+ (((? port? in))
+ (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 char-set:ascii #\newline #\return) c)
+ (string c)
+ (format #f "=~:@(~2,'0x~)" x))))))))))
(define (q-encoding-decode str)
(quoted-printable-decode