view: Allow downloading any message part.

2 files changed, 23 insertions, 9 deletions

diff --git a/assets/css/screen.css b/assets/css/screen.css
index 4bbcfb7..6f92864 100644
--- a/assets/css/screen.css
+++ b/assets/css/screen.css
@@ -165,6 +165,12 @@ table {
     content: "";
 }
 
+.download-part {
+    float: right;
+    font-size: 0.8em;
+    font-style: italic;
+}
+
 .message .from .address {
     font-weight: bold;
 }
diff --git a/mumi/web/view/utils.scm b/mumi/web/view/utils.scm
index 8043c4e..2c03c35 100644
--- a/mumi/web/view/utils.scm
+++ b/mumi/web/view/utils.scm
@@ -111,17 +111,24 @@
   "Convenience procedure to render MESSAGE (part of bug with number
 BUG-NUM), even when it is a multipart message."
   (define (display-multipart-chunk headers body . path)
+    (define (attachment-url)
+      (string-append "/issue/"
+                     (number->string bug-num)
+                     "/attachment/"
+                     (number->string (email-msg-num message))
+                     "/" (string-join (map number->string path) "/")))
     (let* ((type
             (and=> (assoc-ref headers "content-type")
                    (lambda (value)
                      (content-type->css-class (first value)))))
-           (binary-attachment?
+           (attachment?
             (and (and=> (assoc-ref headers "content-disposition")
                         (lambda (value)
                           (string-contains (first value) "attachment")))
                  type
-                 (string-contains type "application")
-                 (first (assoc-ref headers "content-disposition"))))
+                 (string-contains type "application")))
+           (binary-attachment? (and attachment?
+                                    (string-contains type "application")))
            (attachment-name
             (or (and=> (assoc-ref headers "content-disposition")
                        (lambda (value)
@@ -133,17 +140,18 @@ BUG-NUM), even when it is a multipart message."
        (binary-attachment?
         `(div (@ (class "attachment"))
               "Attachment: "
-              (a (@ (href ,(string-append "/issue/"
-                                          (number->string bug-num)
-                                          "/attachment/"
-                                          (number->string (email-msg-num message))
-                                          "/" (string-join (map number->string path) "/"))))
-                 ,attachment-name)))
+              (a (@ (href ,(attachment-url))) ,attachment-name)))
        ((string-suffix? ".scm" attachment-name)
         `(div (@ (class "multipart scheme"))
+              (div (@ (class "download-part"))
+                   (a (@ (href ,(attachment-url)))
+                      "Download"))
               ,(highlights->sxml (highlight lex-scheme body))))
        (else
         `(div (@ (class ,(string-join `("multipart" ,(or type "")))))
+              (div (@ (class "download-part"))
+                   (a (@ (href ,(attachment-url)))
+                      "Download"))
               ,(prettify body))))))
   (cond
    ((multipart-message? message)