view: Allow downloading any message part.
authorRicardo Wurmus <rekado@elephly.net>
Fri, 7 Sep 2018 11:01:52 +0000 (13:01 +0200)
committerRicardo Wurmus <rekado@elephly.net>
Fri, 7 Sep 2018 11:01:52 +0000 (13:01 +0200)
assets/css/screen.css
mumi/web/view/utils.scm

index 4bbcfb7fc4d9c9de2ee3a71b57a8264ce5021696..6f92864628427388a45ee04a1a78bd055f904406 100644 (file)
@@ -165,6 +165,12 @@ table {
     content: "";
 }
 
+.download-part {
+    float: right;
+    font-size: 0.8em;
+    font-style: italic;
+}
+
 .message .from .address {
     font-weight: bold;
 }
index 8043c4ef3decc6b2bc94406a36acfec4cae92cb7..2c03c35fd7c60f8a1d75133288b3f2ff7cd2d825 100644 (file)
   "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)