css: Draw multipart separator also when following an attachment.
[software/mumi.git] / mumi / web / view / html.scm
index 8de7264c59e563dcfba186ad8cde9e0aecf34063..f6d50e94797ef413f6786568d2d62bc470334815 100644 (file)
@@ -17,9 +17,9 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (mumi web view html)
-  #:use-module (debbugs bug)
   #:use-module (email email)
   #:use-module (mumi config)
+  #:use-module (mumi debbugs)
   #:use-module (mumi messages)
   #:use-module (mumi web view utils)
   #:use-module (mumi web util)
@@ -32,7 +32,8 @@
             error-page
             issue-page
             list-of-matching-bugs
-            list-of-recent-issues))
+            list-of-recent-issues
+            list-of-forgotten-issues))
 
 (define (bug-subject* bug)
   (or (bug-subject bug) "(no subject)"))
@@ -71,7 +72,7 @@
        (@ (rel "stylesheet")
           (media "screen")
           (type "text/css")
-          (href "/css/screen.css?202005070001"))))
+          (href "/css/screen.css?202005160000"))))
      (body ,@body
            (footer (@ (class "text-center"))
                    (p "Copyright © 2016—2020 by the GNU Guix community."
@@ -156,6 +157,12 @@ simple query language.  Here is a list of supported query terms:")
            (span (@ (class "filter"))
                  "submitter:me")
            ", "
+           (span (@ (class "filter"))
+                 "severity:serious")
+           ", "
+           (span (@ (class "filter"))
+                 "tag:easy")
+           ", "
            (span (@ (class "filter"))
                  "date:2d..now")
            ", "
@@ -210,6 +217,19 @@ simple query language.  Here is a list of supported query terms:")
        (tbody
         ,@(list-of-bugs (recent-bugs 10))))
 
+      (div (@ (class "mt-4 h4")) "Forgotten issues "
+           (small (a (@ (href "forgotten")) "(More)")))
+      (table
+       (@ (class "table table-borderless table-hover js-sort-table"))
+       (thead
+        (tr (@ (class "heading"))
+            (th (@ (class "js-sort-number")) "ID")
+            (th "Subject")
+            (th "Date submitted")
+            (th "Status")))
+       (tbody
+        ,@(list-of-bugs (forgotten-issues 10))))
+
       (div (@ (class "mt-4 h4")) "Priority bugs")
       (table
        (@ (class "table table-borderless table-hover js-sort-table"))
@@ -262,6 +282,36 @@ some examples.")
              (span (@ (class "filter")) "author:rekado")
              " for all messages where rekado has commented. "
              "The filter matches both the email address and the name."))
+        (tr
+         (td (span (@ (class "filter")) "severity:<type>"))
+         (td "Issues that have been marked with the given severity, e.g. "
+             (span (@ (class "filter")) "severity:serious")
+             " for all issues that have been labelled as serious bugs. "
+             "The following severities are recognized: "
+             (strong "critical") ", "
+             (strong "grave") ", "
+             (strong "serious") ", "
+             (strong "important") ", "
+             (strong "normal") ", "
+             (strong "minor") ", and "
+             (strong "wishlist") "."))
+        (tr
+         (td (span (@ (class "filter")) "tag:<type>"))
+         (td "Issues that have been tagged with the given tag, e.g. "
+             (span (@ (class "filter")) "tag:easy")
+             " for all easy issues that are suitable for newcomers. "
+             "The following tags are recognized: "
+             (strong "patch") ", "
+             (strong "wontfix") ", "
+             (strong "moreinfo") ", "
+             (strong "unreproducible") ", "
+             (strong "fixed") ", "
+             (strong "notabug") ", "
+             (strong "pending") ", "
+             (strong "help") ", "
+             (strong "security") ", "
+             (strong "confirmed") ", and "
+             (strong "easy") "."))
         (tr
          (td (span (@ (class "filter")) "date:<start>..<end>"))
          (td "Issues submitted within the provided range.  "
@@ -305,7 +355,13 @@ failed to process associated messages.")
 (define* (issue-page bug #:optional flash-message)
   "Render the conversation for the given BUG."
   (define id (bug-num bug))
-  (define messages (issue-messages id))
+  (define messages
+    (filter (lambda (msg)
+              ;; Ignore messages without body, and internal messages.
+              (and msg
+                   (email-body msg)
+                   (not (internal-message? msg))))
+            (issue-messages id)))
   (define parties (sort (filter (compose (negate bot?) extract-email)
                                 (participants (filter identity messages)))
                         (lambda (a b)
@@ -325,7 +381,7 @@ failed to process associated messages.")
                    (span (@ (class "date"))
                          (a (@ (href ,(string-append "#" (number->string
                                                           message-number))))
-                            ,(date->string (date message))))))
+                            ,(time->string (date message))))))
                messages
                (iota (length messages)))))
   (define issue-details
@@ -453,7 +509,15 @@ failed to process associated messages.")
                   (@ (class "card-footer"))
                   (button (@ (class "btn btn-primary")
                              (type "submit"))
-                          "Send"))))
+                          "Send")
+                  (span (@ (class "ml-3"))
+                   "Your may also "
+                   (a (@ (href ,(string-append "mailto:"
+                                               (number->string id) "@" (%config 'debbugs-domain)
+                                               "?subject=" (bug-subject* bug))))
+                      ,(string-append "send email to "
+                                      (number->string id) "@" (%config 'debbugs-domain)))
+                   " to comment."))))
               `((div
                  (@ (class "card-header"))
                  (div (@ (class "from"))
@@ -495,11 +559,16 @@ currently disabled."))
                                                         (map extract-email parties)))))
                 ,(string-upcase (string-take (sender-name message) 1)))
                (span (@ (class "address")) ,(sender-name message))
-               " wrote on "
+               " wrote "
                (span (@ (class "date"))
                      (a (@ (href ,(string-append "#" (number->string
-                                                      message-number))))
-                        ,(date->string (date message)))))
+                                                      message-number)))
+                           (title ,(date->string (date message))))
+                        ,(time->string (date message)))))
+              (div (@ (class "download-message"))
+                   (a (@ (href ,(format #f "issue/~a/raw/~a"
+                                        id message-number)))
+                      ,download-icon))
               ,@(if (string-suffix? previous-subject (subject message))
                     '()
                     `((div (@ (class "subject")) ,(subject message))))
@@ -551,20 +620,11 @@ currently disabled."))
           (div (@ (class "row"))
                (div
                 (@ (class "conversation col-12"))
-                ,(let ((msgs (filter (lambda (msg)
-                                       ;; Ignore messages
-                                       ;; without body, and
-                                       ;; internal messages.
-                                       (and msg
-                                            (email-body msg)
-                                            (not (internal-message? msg))))
-                                     messages)))
-                   (map (lambda (message-number msg previous-subject)
-                          (show-message message-number msg previous-subject))
-                        (iota (length msgs))
-                        msgs
-                        (cons (bug-subject* bug)
-                              (map subject msgs))))
+                ,(map show-message
+                      (iota (length messages))
+                      messages
+                      (cons (bug-subject* bug)
+                            (map subject messages)))
                 ,comment-box)))))))
 
 (define (list-of-bugs bugs)
@@ -592,6 +652,16 @@ M7 1C3.14 1 0 4.14 0 8\
 s3.14 7 7 7 7-3.14 7-7-3.14-7-7-7z\
 m1 3H6v5h2V4zm0 6H6v2h2v-2z")))))
                        '())
+                 ,@(or (and=> (bug-tags bug)
+                              (lambda (tags)
+                                (map (lambda (tag)
+                                       `(a (@ (href ,(string-append "search?query=tag:" tag)))
+                                           (span
+                                            (@ (class ,(string-append "badge badge-info mr-1 "
+                                                                      tag)))
+                                            ,tag)))
+                                     (string-split tags #\space))))
+                       '())
                  ,(if id
                          `(a (@ (href ,(string-append "/" id)))
                              ,(bug-subject* bug))
@@ -625,6 +695,24 @@ m1 3H6v5h2V4zm0 6H6v2h2v-2z")))))
        (tbody
         ,@(list-of-bugs (recent-bugs max))))))))
 
+(define* (list-of-forgotten-issues #:optional (max 100))
+  (layout
+   #:body
+   `(,(header #:search-bar? #f)
+     (div
+      (@ (class "container"))
+      (h1 "Forgotten issues")
+      (table
+       (@ (class "table table-borderless table-hover js-sort-table"))
+       (thead
+        (tr (@ (class "heading"))
+            (th (@ (class "js-sort-number")) "ID")
+            (th "Subject")
+            (th "Date submitted")
+            (th "Status")))
+       (tbody
+        ,@(list-of-bugs (forgotten-issues max))))))))
+
 (define (list-of-matching-bugs query bugs)
   (layout
    #:body