From 2784c121d5a3c9d8e7831c883edac3b6857bc198 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Wed, 12 Sep 2018 17:52:08 +0530
Subject: Untabify and re-indent all sources.
* build-aux/test-driver.scm, email/base64.scm, email/email.scm,
email/quoted-printable.scm, email/utils.scm,
tests/quoted-printable.scm: Untabify and re-indent.
---
build-aux/test-driver.scm | 16 +-
email/base64.scm | 16 +-
email/email.scm | 398 ++++++++++++++++++++++-----------------------
email/quoted-printable.scm | 68 ++++----
email/utils.scm | 46 +++---
tests/quoted-printable.scm | 14 +-
6 files changed, 279 insertions(+), 279 deletions(-)
diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 25aaf44..0daad1d 100644
--- a/build-aux/test-driver.scm
+++ b/build-aux/test-driver.scm
@@ -18,8 +18,8 @@
;;; .
(use-modules (ice-9 getopt-long)
- (srfi srfi-26)
- (srfi srfi-64))
+ (srfi srfi-26)
+ (srfi srfi-64))
;; Currently, only log-file and trs-file are understood. Everything
;; else is ignored.
@@ -35,11 +35,11 @@
(let ((runner (test-runner-simple)))
(test-runner-on-test-end! runner
(lambda (runner)
- (format trs-port ":test-result: ~A ~A~%"
- (string-upcase
- (symbol->string
- (test-result-kind runner)))
- (test-runner-test-name runner))))
+ (format trs-port ":test-result: ~A ~A~%"
+ (string-upcase
+ (symbol->string
+ (test-result-kind runner)))
+ (test-runner-test-name runner))))
runner))
@@ -48,4 +48,4 @@
(call-with-output-file (option-ref opts 'trs-file #f)
(lambda (trs-port)
(test-with-runner (my-gnu-runner trs-port)
- (load-from-path (option-ref opts 'test-name #f))))))
+ (load-from-path (option-ref opts 'test-name #f))))))
diff --git a/email/base64.scm b/email/base64.scm
index 6b11b3f..94b7388 100644
--- a/email/base64.scm
+++ b/email/base64.scm
@@ -142,9 +142,9 @@
(put p #\=)))))))
(extract)))))
- ;; Decodes a base64 string. The string must contain only pure
- ;; unpadded base64 data.
-
+;; Decodes a base64 string. The string must contain only pure
+;; unpadded base64 data.
+
(define base64-decode
(case-lambda
((str)
@@ -199,11 +199,11 @@
(eof-object)
(f (get-line port))))
- ;; Reads the common -----BEGIN/END type----- delimited format from
- ;; the given port. Returns two values: a string with the type and a
- ;; bytevector containing the base64 decoded data. The second value
- ;; is the eof object if there is an eof before the BEGIN delimiter.
-
+;; Reads the common -----BEGIN/END type----- delimited format from
+;; the given port. Returns two values: a string with the type and a
+;; bytevector containing the base64 decoded data. The second value
+;; is the eof object if there is an eof before the BEGIN delimiter.
+
(define (get-delimited-base64 port)
(define (get-first-data-line port)
;; Some MIME data has header fields in the same format as mail
diff --git a/email/email.scm b/email/email.scm
index ccda3ac..d836908 100644
--- a/email/email.scm
+++ b/email/email.scm
@@ -33,26 +33,26 @@
#:use-module (email base64)
#:use-module (email quoted-printable)
#:use-module ((email utils)
- #:select (get-line-with-delimiter
- read-objects read-while
- acons* alist-delete*))
+ #:select (get-line-with-delimiter
+ read-objects read-while
+ acons* alist-delete*))
#:export (
- make-email
- email?
- email-headers
- email-body
-
- make-mime-entity
- mime-entity?
- mime-entity-headers
- mime-entity-body
- email->headers+body
- parse-email
- parse-email-headers
- parse-email-body
- parse-email-address
- interpret-address
- mbox->emails))
+ make-email
+ email?
+ email-headers
+ email-body
+
+ make-mime-entity
+ mime-entity?
+ mime-entity-headers
+ mime-entity-body
+ email->headers+body
+ parse-email
+ parse-email-headers
+ parse-email-body
+ parse-email-address
+ interpret-address
+ mbox->emails))
(define (flatten-and-filter terms tree)
(filter list? (keyword-flatten terms tree)))
@@ -98,7 +98,7 @@
;; Printable ASCII characters and UTF-8 characters > \x7f (RFC6532)
(define-peg-pattern vchar body
(and (not-followed-by (or (range #\Nul #\Space)
- "\x7f"))
+ "\x7f"))
peg-any))
(define-peg-pattern wsp body
@@ -110,7 +110,7 @@
(define-syntax-rule (define-printable-ascii-character-pattern name . exceptions)
(define-peg-pattern name body
(and (not-followed-by (or . exceptions))
- vchar)))
+ vchar)))
;;; Quoted characters
@@ -383,7 +383,7 @@
;; TODO: What is a CTL in RFC2045?
(define-peg-pattern token body
(+ (and (not-followed-by (or " " crlf tspecials))
- peg-any)))
+ peg-any)))
;; TODO: Implement iana-token, ietf-token and x-token
(define-peg-pattern iana-token body
@@ -474,31 +474,31 @@
;; RFC5322.
(define-peg-pattern fields all
(* (or trace
- resent-date
- resent-from
- resent-sender
- resent-to
- resent-cc
- resent-bcc
- resent-msg-id
- orig-date
- from
- sender
- reply-to
- to
- cc
- bcc
- message-id
- in-reply-to
- references
- subject
- comments
- keywords
- mime-version
- content
- disposition
- encoding
- optional-field)))
+ resent-date
+ resent-from
+ resent-sender
+ resent-to
+ resent-cc
+ resent-bcc
+ resent-msg-id
+ orig-date
+ from
+ sender
+ reply-to
+ to
+ cc
+ bcc
+ message-id
+ in-reply-to
+ references
+ subject
+ comments
+ keywords
+ mime-version
+ content
+ disposition
+ encoding
+ optional-field)))
(define-peg-pattern mime-extension-field-name all
(and "Content-" (+ ftext)))
@@ -508,25 +508,25 @@
(define-peg-pattern mime-entity-fields all
(* (or content
- disposition
- encoding
- mime-extension-field
- optional-field)))
+ disposition
+ encoding
+ mime-extension-field
+ optional-field)))
(define (decode-mime-encoded-word word)
(regexp-substitute/global
#f "=\\?([^?]*)\\?([^?]*)\\?([^?]*)\\?=" word
'pre (lambda (match-record)
- (let ((charset (match:substring match-record 1))
- (encoding (string->lcase-symbol (match:substring match-record 2)))
- (encoded-text (match:substring match-record 3)))
- (bytevector->string
- ((case encoding
- ((b) base64-decode)
- ((q) q-encoding-decode)
- (else (error "Encoding of MIME word unknown" word)))
- encoded-text)
- charset)))
+ (let ((charset (match:substring match-record 1))
+ (encoding (string->lcase-symbol (match:substring match-record 2)))
+ (encoded-text (match:substring match-record 3)))
+ (bytevector->string
+ ((case encoding
+ ((b) base64-decode)
+ ((q) q-encoding-decode)
+ (else (error "Encoding of MIME word unknown" word)))
+ encoded-text)
+ charset)))
'post))
(define (body->mime-entities body boundary)
@@ -534,13 +534,13 @@
explained in RFC2045), and return that list."
(define (read-till-boundary port)
(read-while port get-line-with-delimiter
- (negate (cut string-prefix? (string-append "--" boundary) <>))))
+ (negate (cut string-prefix? (string-append "--" boundary) <>))))
(define (read-mime-entity port)
(if (string-prefix? (string-append "--" boundary "--")
- (get-line-with-delimiter port))
- (eof-object)
- (read-till-boundary port)))
+ (get-line-with-delimiter port))
+ (eof-object)
+ (read-till-boundary port)))
(call-with-input-string body
(lambda (port)
@@ -552,12 +552,12 @@ explained in RFC2045), and return that list."
(call-with-input-string email
(lambda (port)
(let ((headers (read-while port get-line-with-delimiter
- (lambda (line)
- (not (or (string= line "\n")
- (string= line "\r\n")))))))
- (get-line-with-delimiter port)
- (values headers
- (read-while port get-line-with-delimiter identity))))))
+ (lambda (line)
+ (not (or (string= line "\n")
+ (string= line "\r\n")))))))
+ (get-line-with-delimiter port)
+ (values headers
+ (read-while port get-line-with-delimiter identity))))))
(define (post-process-content-transfer-encoding _ value)
(list 'content-transfer-encoding (string->lcase-symbol value)))
@@ -565,47 +565,47 @@ explained in RFC2045), and return that list."
(define post-process-content-type
(match-lambda*
(`(content (type ,type)
- (subtype ,subtype)
- . ,parameters)
+ (subtype ,subtype)
+ . ,parameters)
(let ((type (string->lcase-symbol type))
- (subtype (string->lcase-symbol subtype)))
+ (subtype (string->lcase-symbol subtype)))
`(content-type
- ,(acons* 'type type
- 'subtype subtype
- (let ((parameters
- (map (match-lambda
- (`(parameter (attribute ,attribute)
- (value ,value))
- (cons (string->lcase-symbol attribute) value)))
- (flatten-and-filter '(parameter) parameters))))
- (if (and (eq? type 'text)
- (not (assoc-ref parameters 'charset)))
- ;; UTF-8 is specified as the default charset in RFC6657
- (acons 'charset "utf-8" parameters)
- parameters))))))))
+ ,(acons* 'type type
+ 'subtype subtype
+ (let ((parameters
+ (map (match-lambda
+ (`(parameter (attribute ,attribute)
+ (value ,value))
+ (cons (string->lcase-symbol attribute) value)))
+ (flatten-and-filter '(parameter) parameters))))
+ (if (and (eq? type 'text)
+ (not (assoc-ref parameters 'charset)))
+ ;; UTF-8 is specified as the default charset in RFC6657
+ (acons 'charset "utf-8" parameters)
+ parameters))))))))
(define post-process-content-disposition
(match-lambda*
(`(disposition ,type . ,parameters)
`(content-disposition
,(acons 'type (string->lcase-symbol type)
- (map (match-lambda
- (('filename-parm ('value filename))
- (cons 'filename (basename filename)))
- (((? (lambda (date-parm)
- (member date-parm '(creation-date-parm modification-date-parm read-date-parm)))
- date-parm) value)
- ;; TODO: Convert to SRFI-19 datetime
- (cons date-parm value))
- (('size-parm value)
- (cons 'size (string->number value)))
- (`(parameter (attribute ,attribute)
- (value ,value))
- (cons (string->lcase-symbol attribute) value)))
- (flatten-and-filter
- '(filename-parm creation-date-parm modification-date-parm
- read-date-parm size-parm parameter)
- parameters)))))))
+ (map (match-lambda
+ (('filename-parm ('value filename))
+ (cons 'filename (basename filename)))
+ (((? (lambda (date-parm)
+ (member date-parm '(creation-date-parm modification-date-parm read-date-parm)))
+ date-parm) value)
+ ;; TODO: Convert to SRFI-19 datetime
+ (cons date-parm value))
+ (('size-parm value)
+ (cons 'size (string->number value)))
+ (`(parameter (attribute ,attribute)
+ (value ,value))
+ (cons (string->lcase-symbol attribute) value)))
+ (flatten-and-filter
+ '(filename-parm creation-date-parm modification-date-parm
+ read-date-parm size-parm parameter)
+ parameters)))))))
(define post-process-optional-field
(match-lambda*
@@ -613,7 +613,7 @@ explained in RFC2045), and return that list."
(field-name ,field-name)
,field-value)
(list (string->lcase-symbol field-name)
- field-value))
+ field-value))
(`(optional-field (field-name ,field-name))
(list field-name ""))))
@@ -634,12 +634,12 @@ For example,
(cond
((string-match "([^<]*)<([^>]*)>" address)
=> (lambda (match-record)
- (let ((name (string-trim-both (match:substring match-record 1)))
- (address (match:substring match-record 2)))
- (if (string-null? name)
- `((address . ,address))
- `((name . ,name)
- (address . ,address))))))
+ (let ((name (string-trim-both (match:substring match-record 1)))
+ (address (match:substring match-record 2)))
+ (if (string-null? name)
+ `((address . ,address))
+ `((name . ,name)
+ (address . ,address))))))
(else `((address . ,address)))))
(define interpret-address
@@ -658,50 +658,50 @@ message. Else, return a single record."
(case (assoc-ref content-type 'type)
((multipart)
(map parse-mime-entity
- (body->mime-entities body (assoc-ref content-type 'boundary))))
+ (body->mime-entities body (assoc-ref content-type 'boundary))))
((text)
(string-trim-both
- (decode-body body (assoc-ref headers 'content-transfer-encoding)
- (assoc-ref content-type 'charset))))
+ (decode-body body (assoc-ref headers 'content-transfer-encoding)
+ (assoc-ref content-type 'charset))))
(else (decode-body body (assoc-ref headers 'content-transfer-encoding))))))
(define (add-default-headers headers)
;; Default Content-Type and Content-Transfer-Encoding headers as
;; specified in RFC2045
(let ((default-headers
- (acons* 'content-type '((type . text)
- (subtype . plain)
- ;; UTF-8 is specified as the default
- ;; charset in RFC6657
- (charset . "utf-8"))
- 'content-transfer-encoding '#{7bit}#)))
+ (acons* 'content-type '((type . text)
+ (subtype . plain)
+ ;; UTF-8 is specified as the default
+ ;; charset in RFC6657
+ (charset . "utf-8"))
+ 'content-transfer-encoding '#{7bit}#)))
(append (alist-delete* (append (if (assoc-ref headers 'content-type)
- (list 'content-type) (list))
- (if (assoc-ref headers 'content-transfer-encoding)
- (list 'content-transfer-encoding) (list)))
- default-headers)
- headers)))
+ (list 'content-type) (list))
+ (if (assoc-ref headers 'content-transfer-encoding)
+ (list 'content-transfer-encoding) (list)))
+ default-headers)
+ headers)))
(define (parse-mime-entity text)
(let-values (((headers body) (email->headers+body text)))
(let ((headers
- (pre-post-order
- (peg:tree
- (match-pattern mime-entity-fields text))
- `((content . ,post-process-content-type)
- (encoding . ,post-process-content-transfer-encoding)
- (disposition . ,post-process-content-disposition)
- (optional-field . ,post-process-optional-field)
- (mime-entity-fields . ,(lambda (_ . mime-entity-fields)
- (add-default-headers
- (map (match-lambda
- ((mime-entity-field value)
- (cons mime-entity-field value))
- ((mime-entity-field . values)
- (cons mime-entity-field values)))
- mime-entity-fields))))
- (*text* . ,(lambda (_ text) text))
- (*default* . ,(lambda tree tree))))))
+ (pre-post-order
+ (peg:tree
+ (match-pattern mime-entity-fields text))
+ `((content . ,post-process-content-type)
+ (encoding . ,post-process-content-transfer-encoding)
+ (disposition . ,post-process-content-disposition)
+ (optional-field . ,post-process-optional-field)
+ (mime-entity-fields . ,(lambda (_ . mime-entity-fields)
+ (add-default-headers
+ (map (match-lambda
+ ((mime-entity-field value)
+ (cons mime-entity-field value))
+ ((mime-entity-field . values)
+ (cons mime-entity-field values)))
+ mime-entity-fields))))
+ (*text* . ,(lambda (_ text) text))
+ (*default* . ,(lambda tree tree))))))
(make-mime-entity headers (parse-email-body headers body)))))
(define (parse-email email)
@@ -719,39 +719,39 @@ list of header keys and values."
(peg:tree
(match-pattern fields headers))
`((date-time . ,(lambda node
- (match-let
- ((`((day ,day) (month ,month) (year ,year)
- (hours ,hours) (minutes ,minutes) (seconds ,seconds)
- (zone-sign ,zone-sign) (zone-hours ,zone-hours) (zone-minutes ,zone-minutes))
- (flatten-and-filter
- '(day month year hours minutes seconds
- zone-sign zone-hours zone-minutes)
- node)))
- (make-date 0
- (string->number seconds)
- (string->number minutes)
- (string->number hours)
- (string->number day)
- (1+ (list-index
- (cut equal? <> month)
- (list "Jan" "Feb" "Mar" "Apr" "May" "Jun"
- "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
- (string->number year)
- (* (case (string->symbol zone-sign)
- ((+) 1)
- ((-) -1))
- (+ (* 60 60 (string->number zone-hours))
- (* 60 (string->number zone-minutes))))))))
+ (match-let
+ ((`((day ,day) (month ,month) (year ,year)
+ (hours ,hours) (minutes ,minutes) (seconds ,seconds)
+ (zone-sign ,zone-sign) (zone-hours ,zone-hours) (zone-minutes ,zone-minutes))
+ (flatten-and-filter
+ '(day month year hours minutes seconds
+ zone-sign zone-hours zone-minutes)
+ node)))
+ (make-date 0
+ (string->number seconds)
+ (string->number minutes)
+ (string->number hours)
+ (string->number day)
+ (1+ (list-index
+ (cut equal? <> month)
+ (list "Jan" "Feb" "Mar" "Apr" "May" "Jun"
+ "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
+ (string->number year)
+ (* (case (string->symbol zone-sign)
+ ((+) 1)
+ ((-) -1))
+ (+ (* 60 60 (string->number zone-hours))
+ (* 60 (string->number zone-minutes))))))))
(orig-date . ,(lambda (_ date) (list 'date date)))
(angle-addr . ,extract-value)
(mailbox . ,(match-lambda*
- (`(mailbox (display-name ,name) ,address)
- `((name . ,(decode-mime-encoded-word
- (string-trim-both name)))
- (address . ,address)))
- (`(mailbox ,address)
- `((address . ,(string-trim-both address))))
- (_ (error "Failed to parse mailbox"))))
+ (`(mailbox (display-name ,name) ,address)
+ `((name . ,(decode-mime-encoded-word
+ (string-trim-both name)))
+ (address . ,address)))
+ (`(mailbox ,address)
+ `((address . ,(string-trim-both address))))
+ (_ (error "Failed to parse mailbox"))))
(address-list *macro* . ,macro-process-address-list)
(mailbox-list *macro* . ,macro-process-address-list)
(optional-field . ,post-process-optional-field)
@@ -760,45 +760,45 @@ list of header keys and values."
(encoding . ,post-process-content-transfer-encoding)
(disposition . ,post-process-content-disposition)
(fields . ,(lambda (_ . fields)
- (add-default-headers
- (filter-map (match-lambda
- (('trace . _) #f)
- ((field value)
- (cons field value))
- ((field . values)
- (cons field values))
- (_ #f))
- fields))))
+ (add-default-headers
+ (filter-map (match-lambda
+ (('trace . _) #f)
+ ((field value)
+ (cons field value))
+ ((field . values)
+ (cons field values))
+ (_ #f))
+ fields))))
(*text* . ,extract-value)
(*default* . ,(lambda tree tree)))))
(define* (decode-body body encoding #:optional charset)
(let ((octets
- (case encoding
- ((base64)
- (base64-decode
- (string-filter
- (char-set-union
- (ucs-range->char-set (char->integer #\a) (1+ (char->integer #\z)))
- (ucs-range->char-set (char->integer #\A) (1+ (char->integer #\Z)))
- (ucs-range->char-set (char->integer #\0) (1+ (char->integer #\9)))
- (char-set #\+ #\/ #\=))
- body)))
- ((quoted-printable) (quoted-printable-decode body))
- ((#{7bit}# #{8bit}# binary) body)
- (else (error "Body decoding failed. Unknown encoding" encoding)))))
+ (case encoding
+ ((base64)
+ (base64-decode
+ (string-filter
+ (char-set-union
+ (ucs-range->char-set (char->integer #\a) (1+ (char->integer #\z)))
+ (ucs-range->char-set (char->integer #\A) (1+ (char->integer #\Z)))
+ (ucs-range->char-set (char->integer #\0) (1+ (char->integer #\9)))
+ (char-set #\+ #\/ #\=))
+ body)))
+ ((quoted-printable) (quoted-printable-decode body))
+ ((#{7bit}# #{8bit}# binary) body)
+ (else (error "Body decoding failed. Unknown encoding" encoding)))))
(if charset
- (case encoding
- ((base64 quoted-printable) (bytevector->string octets charset))
- ((#{7bit}# #{8bit}# binary) octets))
- octets)))
+ (case encoding
+ ((base64 quoted-printable) (bytevector->string octets charset))
+ ((#{7bit}# #{8bit}# binary) octets))
+ octets)))
(define (read-next-email-in-mbox port)
;; Read and discard From_ line
(get-line-with-delimiter port)
;; Read the actual email
(read-while port get-line-with-delimiter
- (negate (cut string-prefix? "From " <>))))
+ (negate (cut string-prefix? "From " <>))))
(define (mbox->emails port)
(read-objects read-next-email-in-mbox port))
diff --git a/email/quoted-printable.scm b/email/quoted-printable.scm
index d084a7e..b6f4c54 100644
--- a/email/quoted-printable.scm
+++ b/email/quoted-printable.scm
@@ -23,8 +23,8 @@
#:use-module (ice-9 match)
#:use-module (srfi srfi-26)
#:export (quoted-printable-decode
- quoted-printable-encode
- q-encoding-decode))
+ quoted-printable-encode
+ q-encoding-decode))
;; TODO: Error out on invalid quoted-printable input
(define quoted-printable-decode
@@ -33,30 +33,30 @@
(call-with-input-string str quoted-printable-decode))
(((? port? in))
(let-values (((out get-bytevector)
- (open-bytevector-output-port)))
+ (open-bytevector-output-port)))
(call-with-port
- out (lambda (out)
- (quoted-printable-decode in out)
- (get-bytevector)))))
+ out (lambda (out)
+ (quoted-printable-decode in out)
+ (get-bytevector)))))
(((? port? in) (? port? out))
(let ((c (read-char in)))
(cond
- ((eof-object? c) out)
- ((char=? c #\=)
- ;; TODO: Support "\r\n" line ending
- (let ((c1 (read-char in)))
- (unless (char=? c1 #\Newline)
- (let ((c2 (read-char in)))
- (put-u8 out (string->number (string c1 c2) 16)))))
- (quoted-printable-decode in out))
- (else (put-u8 out (char->integer c))
- (quoted-printable-decode in out)))))))
+ ((eof-object? c) out)
+ ((char=? c #\=)
+ ;; TODO: Support "\r\n" line ending
+ (let ((c1 (read-char in)))
+ (unless (char=? c1 #\Newline)
+ (let ((c2 (read-char in)))
+ (put-u8 out (string->number (string c1 c2) 16)))))
+ (quoted-printable-decode in out))
+ (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))
+ quoted-printable-encode))
(((? port? in))
(call-with-output-string
(cut quoted-printable-encode in <>)))
@@ -64,24 +64,24 @@
(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))))))
+ (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))))))))))
+ (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
diff --git a/email/utils.scm b/email/utils.scm
index 7d51ebb..e942fc2 100644
--- a/email/utils.scm
+++ b/email/utils.scm
@@ -23,18 +23,18 @@
#:use-module (ice-9 textual-ports)
#:use-module (rnrs io simple)
#:export (get-line-with-delimiter
- read-objects
- read-while
- acons*
- alist-delete*))
+ read-objects
+ read-while
+ acons*
+ alist-delete*))
(define (read-objects read-proc port)
"Read all objects using READ-PROC from PORT and return them as a
list."
(let ((x (read-proc port)))
(if (eof-object? x)
- (list)
- (cons x (read-objects read-proc port)))))
+ (list)
+ (cons x (read-objects read-proc port)))))
(define* (read-while port read-proc pred)
"Read from PORT using READ-PROC while PRED returns #t. READ-PROC is
@@ -45,8 +45,8 @@ string returned by READ-PROC as argument."
(cond
((eof-object? x) x)
((pred x)
- (put-string output x)
- (read-while-loop output))
+ (put-string output x)
+ (read-while-loop output))
(#t (unget-string port x)))))
(let ((str (call-with-output-string read-while-loop)))
@@ -57,8 +57,8 @@ string returned by READ-PROC as argument."
delimiting linefeed character."
(let ((line (get-line port)))
(if (eof-object? line)
- line
- (string-append line "\n"))))
+ line
+ (string-append line "\n"))))
(define acons*
(match-lambda*
@@ -72,24 +72,24 @@ delimiting linefeed character."
"Return a list containing all elements of ALIST whose keys are not a
member of KEYS."
(filter (match-lambda
- ((key . _)
- (not (member key keys))))
- alist))
+ ((key . _)
+ (not (member key keys))))
+ alist))
(define (cg-string-ci pat accum)
(syntax-case pat ()
((pat-str-syntax) (string? (syntax->datum #'pat-str-syntax))
(let ((pat-str (syntax->datum #'pat-str-syntax)))
(let ((plen (string-length pat-str)))
- #`(lambda (str len pos)
- (let ((end (+ pos #,plen)))
- (and (<= end len)
- (string-ci= str #,pat-str pos end)
- #,(case accum
- ((all) #`(list end (list 'cg-string #,pat-str)))
- ((name) #`(list end 'cg-string))
- ((body) #`(list end #,pat-str))
- ((none) #`(list end '()))
- (else (error "bad accum" accum)))))))))))
+ #`(lambda (str len pos)
+ (let ((end (+ pos #,plen)))
+ (and (<= end len)
+ (string-ci= str #,pat-str pos end)
+ #,(case accum
+ ((all) #`(list end (list 'cg-string #,pat-str)))
+ ((name) #`(list end 'cg-string))
+ ((body) #`(list end #,pat-str))
+ ((none) #`(list end '()))
+ (else (error "bad accum" accum)))))))))))
(add-peg-compiler! 'string-ci cg-string-ci)
diff --git a/tests/quoted-printable.scm b/tests/quoted-printable.scm
index cc1b957..a0f0369 100755
--- a/tests/quoted-printable.scm
+++ b/tests/quoted-printable.scm
@@ -18,9 +18,9 @@
;;; .
(use-modules (email quoted-printable)
- (ice-9 iconv)
- (srfi srfi-1)
- (srfi srfi-64))
+ (ice-9 iconv)
+ (srfi srfi-1)
+ (srfi srfi-64))
(test-begin "quoted-printable")
@@ -44,10 +44,10 @@ abriquent pour te la vendre une =C3=A2me vulgaire.")
(test-assert "quoted-printable wikipedia example: encoded output should not be more than 76 columns wide"
(every (lambda (line)
- (<= (string-length line) 76))
- (string-split (quoted-printable-encode
- (string->bytevector decoded-text charset))
- #\newline))))
+ (<= (string-length line) 76))
+ (string-split (quoted-printable-encode
+ (string->bytevector decoded-text charset))
+ #\newline))))
(test-equal "q-encoding wikipedia example"
(bytevector->string
--
cgit v1.2.3