email: Introduce alist union utility.

* email/utils.scm (alist-combine): New function.
(alist-delete*): Delete function.
* email/email.scm (add-default-headers,
add-default-mime-entity-headers): Use alist-combine.

1 files changed, 21 insertions, 31 deletions

diff --git a/email/email.scm b/email/email.scm
index 7665760..43f9a72 100644
--- a/email/email.scm
+++ b/email/email.scm
@@ -775,41 +775,31 @@ message. Else, return a single <mime-entity> record."
 (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}#)))
-    (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)))
+  (alist-combine (acons* 'content-type '((type . text)
+                                         (subtype . plain)
+                                         ;; UTF-8 is specified as the default
+                                         ;; charset in RFC6657
+                                         (charset . "utf-8"))
+                         'content-transfer-encoding '#{7bit}#)
+                 headers))
 
 (define (add-default-mime-entity-headers parent-headers headers)
   ;; Default Content-Type and Content-Transfer-Encoding headers as
   ;; specified in RFC2045 and RFC2046
-  (let* ((parent-content-type (assoc-ref parent-headers 'content-type))
-         (default-headers
-           (acons* 'content-type `(,@(if (and (eq? (assoc-ref parent-content-type 'type) 'multipart)
-                                              (eq? (assoc-ref parent-content-type 'subtype) 'digest))
-                                         '((type . message)
-                                           (subtype . rfc822))
-                                         '((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)))
+  (let ((parent-content-type (assoc-ref parent-headers 'content-type)))
+    (alist-combine
+     (acons* 'content-type
+             `(,@(if (and (eq? (assoc-ref parent-content-type 'type) 'multipart)
+                          (eq? (assoc-ref parent-content-type 'subtype) 'digest))
+                     '((type . message)
+                       (subtype . rfc822))
+                     '((type . text)
+                       (subtype . plain)))
+               ;; UTF-8 is specified as the default
+               ;; charset in RFC6657
+               (charset . "utf-8"))
+             'content-transfer-encoding '#{7bit}#)
+     headers)))
 
 (define (parse-mime-entity parent-headers bv)
   (let-values (((headers body) (email->headers+body bv)))