summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2019-10-08 20:18:02 +0530
committerArun Isaac2019-10-08 20:18:02 +0530
commit1693fcdcb5593dc8f6d245dc1bf1e1202341f9d4 (patch)
treea80b8e6fd57c26351e0cfe55305f473c411f17ef
parent9e15a3447804a6cd5142250e6181a589ef2e5db6 (diff)
downloadguile-email-1693fcdcb5593dc8f6d245dc1bf1e1202341f9d4.tar.gz
guile-email-1693fcdcb5593dc8f6d245dc1bf1e1202341f9d4.tar.lz
guile-email-1693fcdcb5593dc8f6d245dc1bf1e1202341f9d4.zip
email: Deduplicate post processing of header fields.
* email/email.scm (post-process-fields): New function. (parse-mime-entity, decode-body): Invoke post-process-fields.
-rw-r--r--email/email.scm25
1 files changed, 11 insertions, 14 deletions
diff --git a/email/email.scm b/email/email.scm
index 1960456..7665760 100644
--- a/email/email.scm
+++ b/email/email.scm
@@ -719,6 +719,15 @@ values. The returned headers is a string and body is a bytevector."
(define* (macro-process-address-list _ . addresses)
(flatten-and-filter '(address mailbox) addresses))
+(define (post-process-fields fields)
+ (map (match-lambda
+ ((field value)
+ (cons field value))
+ ((field . values)
+ (cons field values))
+ (_ #f))
+ fields))
+
(define (parse-email-address address)
"Parse ADDRESS as an email address and return an association list
with keys being the symbols name and address, and values being the
@@ -815,12 +824,7 @@ message. Else, return a single <mime-entity> record."
(mime-entity-fields . ,(lambda (_ . mime-entity-fields)
(add-default-mime-entity-headers
parent-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))))
+ (post-process-fields mime-entity-fields))))
(*text* . ,(match-lambda*
;; Handle MIME entities that have no
;; headers.
@@ -882,14 +886,7 @@ list of header keys and values."
(subject . ,(match-lambda* (`(subject ,subject)
`(subject ,(decode-mime-encoded-word subject)))))
(fields . ,(lambda (_ . fields)
- (add-default-headers
- (filter-map (match-lambda
- ((field value)
- (cons field value))
- ((field . values)
- (cons field values))
- (_ #f))
- fields))))
+ (add-default-headers (post-process-fields fields))))
(*text* . ,(lambda (_ value) value))
(*default* . ,(lambda tree tree)))))