Use guile-email.

* mumi/messages.scm (extract-name, extract-email, header, sender,
sender-email, date, subject, message-id, participants, recipients,
closing?, multipart-message?): Modify to use guile-email API.
* mumi/web/view/html.scm (issue-page): Likewise.
* mumi/web/view/utils.scm (content-type->css-class,
display-message-body): Likewise.

3 files changed, 52 insertions, 67 deletions

diff --git a/mumi/messages.scm b/mumi/messages.scm
index 0d912c4..a8d0183 100644
--- a/mumi/messages.scm
+++ b/mumi/messages.scm
@@ -26,9 +26,9 @@
   #:use-module (ice-9 textual-ports)
   #:use-module (debbugs soap)
   #:use-module (debbugs operations)
-  #:use-module (debbugs email)
   #:use-module (debbugs bug)
   #:use-module (debbugs rfc822)
+  #:use-module (email email)
   #:use-module (mumi config)
   #:use-module (mailutils mailutils)
   #:export (search-bugs
@@ -40,55 +40,53 @@
             extract-attachment
             qp-decoder))
 
-;; TODO: mu-address-get-personal skips non ASCII characters
-;; ex: (mu-address-get-personal "ludo@gnu.org (Ludovic Courtès)")
-;; => "Ludovic Courts"
 (define-public (extract-name address)
-  (let ((name (mu-header-decode (mu-address-get-personal address))))
-    (if (string-null? name) "Somebody" name)))
+  (or (assoc-ref address 'name)
+      "Somebody"))
 
-(define-public extract-email mu-address-get-email)
+(define-public (extract-email address)
+  (assoc-ref address 'address))
 
 (define (header message key)
-  (and=> (assoc-ref (email-headers message) key) first))
+  (assoc-ref (email-headers message) key))
 
 (define-public (sender message)
-  (header message "from"))
+  (first (header message 'from)))
 
 (define-public sender-email
-  (compose mu-address-get-email sender))
+  (compose extract-email sender))
 
 (define-public (sender-name message)
   (extract-name (sender message)))
 
 (define-public (date message)
-  (header message "date"))
+  (header message 'date))
 
 (define-public (subject message)
-  (header message "subject"))
+  (header message 'subject))
 
 (define-public (message-id message)
-  (header message "message-id"))
+  (header message 'message-id))
 
 (define-public (participants messages)
   "Return a list of unique senders in the conversion."
   (apply lset-adjoin (lambda (a b)
-                       (string= (mu-address-get-email a)
-                                (mu-address-get-email b)))
+                       (string= (extract-email a)
+                                (extract-email b)))
          '() (map sender messages)))
 
 (define-public (recipients message)
   "Return a list of recipient email addresses for the given MESSAGE."
   (let ((headers (email-headers message)))
     (filter-map (match-lambda
-                  (((or "cc" "bcc" "to") val) val)
+                  (((or 'cc 'bcc 'to) val) val)
                   (_ #f)) headers)))
 
 (define-public (closing? message id)
   "Is this MESSAGE closing this bug ID?"
   (let ((done (string-append (number->string id)
                              "-done")))
-    (string= (header message "x-debbugs-envelope-to") done)))
+    (string= (header message 'x-debbugs-envelope-to) done)))
 
 (define-public (bot? address)
   (string= "help-debbugs@gnu.org" address))
@@ -159,7 +157,9 @@ attributes."
        (call-with-input-string line parse-multipart-header)))
 
 (define (multipart-message? message)
-  (multipart-header? (header message "content-type")))
+  (eq? (assoc-ref (header message 'content-type)
+                  'type)
+       'multipart))
 
 (define (qp-decoder port)
   "Read a quoted-printable line from PORT and return the decoded
diff --git a/mumi/web/view/html.scm b/mumi/web/view/html.scm
index cee265f..fcb731f 100644
--- a/mumi/web/view/html.scm
+++ b/mumi/web/view/html.scm
@@ -17,8 +17,8 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (mumi web view html)
-  #:use-module (debbugs email)
   #:use-module (debbugs bug)
+  #:use-module (email email)
   #:use-module (mumi config)
   #:use-module (mumi messages)
   #:use-module (mumi web view utils)
@@ -280,7 +280,7 @@ range.  The supported arguments are the same as for "
            (span (@ (class "date"))
                  (a (@ (href ,(string-append "#" (number->string
                                                   message-number))))
-                    ,(date message))))
+                    ,(date->string (date message)))))
           ,@(if (string-suffix? previous-subject (subject message))
                 '()
                 `((div (@ (class "subject")) ,(subject message))))
diff --git a/mumi/web/view/utils.scm b/mumi/web/view/utils.scm
index cb4e83e..69df0c0 100644
--- a/mumi/web/view/utils.scm
+++ b/mumi/web/view/utils.scm
@@ -25,7 +25,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (syntax-highlight)
   #:use-module (syntax-highlight scheme)
-  #:use-module (debbugs email)
+  #:use-module (email email)
   #:use-module (mumi messages)
   #:export (prettify
             avatar-color
@@ -101,12 +101,9 @@
 
 (define (content-type->css-class value)
   "Convert a content-type header value to a CSS class name."
-  (string-map (lambda (chr)
-                (cond
-                 ((char-set-contains? char-set:letter chr) chr)
-                 (else #\-)))
-              (string-take value (or (string-index value #\;)
-                                     (string-length value)))))
+  (string-append (symbol->string (assoc-ref value 'type))
+                 "-"
+                 (symbol->string (assoc-ref value 'subtype))))
 
 (define (display-message-body bug-num message-number message)
   "Convenience procedure to render MESSAGE (part of bug with number
@@ -118,24 +115,17 @@ BUG-NUM), even when it is a multipart message."
                      "/attachment/"
                      (number->string message-number)
                      "/" (string-join (map number->string path) "/")))
-    (let* ((type
-            (and=> (assoc-ref headers "content-type")
-                   (lambda (value)
-                     (content-type->css-class (first value)))))
+    (let* ((content-type (assoc-ref headers 'content-type))
            (attachment?
-            (and (and=> (assoc-ref headers "content-disposition")
-                        (lambda (value)
-                          (string-contains (first value) "attachment")))
-                 type
-                 (string-contains type "application")))
+            (and (and=> (assoc-ref headers 'content-disposition)
+                        (cut assoc-ref <> 'type))
+                 content-type
+                 (assoc-ref content-type 'type)))
            (binary-attachment? (and attachment?
-                                    (string-contains type "application")))
+                                    (eq? (assoc-ref content-type 'type) 'application)))
            (attachment-name
-            (or (and=> (assoc-ref headers "content-disposition")
-                       (lambda (value)
-                         (and=> (string-match "filename=([^ ;]+)" (first value))
-                                (lambda (m)
-                                  (match:substring m 1)))))
+            (or (and=> (assoc-ref headers 'content-disposition)
+                       (cut assoc-ref <> 'filename))
                 "file")))
       (cond
        (binary-attachment?
@@ -149,37 +139,32 @@ BUG-NUM), even when it is a multipart message."
                       "Download"))
               ,(highlights->sxml (highlight lex-scheme body))))
        (else
-        `(div (@ (class ,(string-join `("multipart" ,(or type "")))))
+        `(div (@ (class ,(string-join
+                          (list "multipart" (or (and content-type
+                                                     (content-type->css-class content-type))
+                                                "")))))
               (div (@ (class "download-part"))
                    (a (@ (href ,(attachment-url)))
                       "Download"))
               ,(prettify body))))))
   (cond
    ((multipart-message? message)
-    => (lambda (attributes)
-         (match (split-multipart-message attributes message)
-           (()
-            (cons
-             `(p (@ (class "error parse"))
-                 "[Failed to process the following multipart message.  Sorry!]")
-             (prettify (email-body message))))
-           (parts
-            (map (lambda (part part-num)
-                   (match part
-                     (() "")
-                     ((#:headers hs #:body '()) "")
-                     ((#:headers hs #:body (? string? body))
-                      (display-multipart-chunk hs body part-num))
-                     ;; Message parts can be nested.
-                     ((#:headers hs #:body sub-parts)
-                      (map (lambda (part sub-part-num)
-                             (match part
-                               ((#:headers hs #:body body)
-                                (display-multipart-chunk hs body part-num sub-part-num))))
-                           sub-parts
-                           (iota (length parts))))))
-                 parts
-                 (iota (length parts)))))))
+    (let ((parts (email-body message)))
+      (map (lambda (part part-num)
+             (match part
+               (($ <mime-entity> headers (? string? body))
+                (display-multipart-chunk headers body part-num))
+               ;; Message parts can be nested.
+               (($ <mime-entity> headers sub-parts)
+                (map (lambda (part sub-part-num)
+                       (match part
+                         (($ <mime-entity> headers body)
+                          (display-multipart-chunk
+                           headers body part-num sub-part-num))))
+                     sub-parts
+                     (iota (length sub-parts))))))
+           parts
+           (iota (length parts)))))
    ;; Regular message with a simple body.
    (else
     (prettify (email-body message)))))