diff options
author | Arun Isaac | 2019-10-08 20:18:02 +0530 |
---|---|---|
committer | Arun Isaac | 2019-10-08 20:18:02 +0530 |
commit | 1693fcdcb5593dc8f6d245dc1bf1e1202341f9d4 (patch) | |
tree | a80b8e6fd57c26351e0cfe55305f473c411f17ef /email | |
parent | 9e15a3447804a6cd5142250e6181a589ef2e5db6 (diff) | |
download | guile-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.
Diffstat (limited to 'email')
-rw-r--r-- | email/email.scm | 25 |
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))))) |