diff options
| author | Arun Isaac | 2018-09-12 17:25:45 +0530 |
|---|---|---|
| committer | Arun Isaac | 2018-09-12 17:25:45 +0530 |
| commit | 959941b87c2e7ba732cae8ad1943432dfba83427 (patch) | |
| tree | 5f55c80b01d6c73e027b7cf8b2b63aaeb142ddd9 /email | |
| parent | dc63650fc9a1617933d7076961a52408ba0d54fd (diff) | |
| download | guile-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.scm | 33 |
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 |