css: Draw multipart separator also when following an attachment.
[software/mumi.git] / mumi / web / view / html.scm
index ad2888c651c96dfa4f1ef33106098a4f2df3d1ae..f6d50e94797ef413f6786568d2d62bc470334815 100644 (file)
@@ -1,5 +1,5 @@
 ;;; mumi -- Mediocre, uh, mail interface
-;;; Copyright © 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
 ;;; <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)
+  #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:export (index
             unknown
             error-page
             issue-page
-            list-of-matching-bugs))
+            list-of-matching-bugs
+            list-of-recent-issues
+            list-of-forgotten-issues))
+
+(define (bug-subject* bug)
+  (or (bug-subject bug) "(no subject)"))
 
 (define (status-tag bug)
   "Return a colored tag indicating the BUG status."
 (define* (layout #:key
                  (head '())
                  (body '())
-                 (title "Guix issue tracker")
-                 (extra-headers '()))
-  `(#:sxml ((doctype "html")
-            (html
-             (head
-              (title ,title)
-              (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8")))
-              (meta (@ (http-equiv "Content-Language") (content "en")))
-              (meta (@ (name "author") (content "Ricardo Wurmus")))
-              (meta (@ (name "viewport")
-                       (content "width=device-width, initial-scale=1")))
-              (link
-               (@ (rel "stylesheet")
-                  (media "screen")
-                  (type "text/css")
-                  (href "/css/reset.css")))
-              (link
-               (@ (rel "stylesheet")
-                  (media "screen")
-                  (type "text/css")
-                  (href "/css/bootstrap.css")))
-              ,@head
-              (link
-               (@ (rel "stylesheet")
-                  (media "screen")
-                  (type "text/css")
-                  (href "/css/screen.css")))
-              (link
-               (@ (rel "stylesheet")
-                  (media "screen")
-                  (type "text/css")
-                  (href "/css/code.css"))))
-             (body ,@body)))
-    #:extra-headers ,extra-headers))
+                 (title "Guix issue tracker"))
+  `((doctype "html")
+    (html (@ (lang "en"))
+     (head
+      (title ,title)
+      (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8")))
+      (meta (@ (name "author") (content "Ricardo Wurmus")))
+      (meta (@ (name "viewport")
+               (content "width=device-width, initial-scale=1")))
+      (link
+       (@ (rel "stylesheet")
+          (media "screen")
+          (type "text/css")
+          (href "/css/reset.css")))
+      (link
+       (@ (rel "stylesheet")
+          (media "screen")
+          (type "text/css")
+          (href "/css/bootstrap.css")))
+      ,@head
+      (link
+       (@ (rel "stylesheet")
+          (media "screen")
+          (type "text/css")
+          (href "/css/screen.css?202005160000"))))
+     (body ,@body
+           (footer (@ (class "text-center"))
+                   (p "Copyright © 2016—2020 by the GNU Guix community."
+                      (br)
+                      "Now with even more " (span (@ (class "lambda")) "λ") "! ")
+                   (p "This is free software.  Download the "
+                      (a (@ (href "https://git.elephly.net/software/mumi.git"))
+                         "source code here") "."))
+           (script
+            (@ (src "/js/sort-table.js")))))))
 
-(define* (search-form #:key (standalone? #f))
+(define* (search-form #:key (standalone? #f) (text ""))
   `(form (@ (id "search")
             ,(if standalone?
-                 '(class "row")
-                 '(class "navbar-form navbar-right"))
+                 '(class "")
+                 '(class "form-inline"))
             (action "/search"))
          (div
           (@ (class ,(if standalone?
                     (class "form-control")
                     (id   "query")
                     (name "query")
-                    (placeholder "input search query")))
-               (span (@ (class "input-group-btn"))
+                    (value ,text)
+                    (placeholder "Input your search query...")))
+          (span (@ (class "input-group-append"))
                     (button
                      (@ (type "submit")
                         (class ,(string-append (if standalone? "btn-lg " "")
                                                "btn btn-primary")))
-                     "Search")))))
-
-(define* (header #:key (search-bar? #t))
-  `(nav
-    (@ (id "header") (class "navbar navbar-default"))
-    (div
-     (@ (class "container-fluid"))
-     (div
-      (@ (class "navbar-header"))
-      (div (@ (class "navbar-brand"))
-           (a (@ (href "/") (class "logo"))
-              (img (@ (src "/img/logo.png")
-                      (alt "Guix patch tracker"))))))
-     ,@(if search-bar?
-           `(,(search-form))
-           '()))))
+                     ;; This SVG is part of Bootstrap and is available
+                     ;; under the Expat license.
+                     (svg
+                      (@ (class "bi bi-search")
+                         (width "1em")
+                         (height "1em")
+                         (viewBox "0 0 16 16")
+                         (fill "currentColor")
+                         (xmlns "http://www.w3.org/2000/svg"))
+                      (title "Search")
+                      (path (@ (fill-rule "evenodd")
+                               (d "M10.442 10.442a1 1 0 011.415 0l3.85 3.85a1 1 0 01-1.414 1.415l-3.85-3.85a1 1 0 010-1.415z")
+                               (clip-rule "evenodd")) "")
+                      (path (@ (fill-rule "evenodd")
+                               (d "M6.5 12a5.5 5.5 0 100-11 5.5 5.5 0 000 11zM13 6.5a6.5 6.5 0 11-13 0 6.5 6.5 0 0113 0z")
+                               (clip-rule "evenodd")) ""))))
+          (div
+           (@ (id "search-hints"))
+           (p "You can improve the search results by making use of the
+simple query language.  Here is a list of supported query terms:")
+           (table
+            (@ (class "table table-sm table-borderless"))
+            (tbody
+             ,@(map (match-lambda
+                      ((term description)
+                       `(tr (td (span (@ (class "filter")) ,term))
+                            (td ,description))))
+                    '(("is:open" "open issues")
+                      ("is:done" "closed issues")
+                      ("submitter:<who>" "search issue submitter")
+                      ("author:<who>" "search by message author")
+                      ("date:yesterday..now" "search by issue date")
+                      ("mdate:3m..2d" "search by message date")))))))))
 
-(define (index)
-  (layout
-   #:extra-headers
-   '((cache-control . ((max-age . 60))))
-   #:body
-   `(,(header #:search-bar? #f)
-     (div
-      (@ (class "container"))
-      (h1 "Guix patch tracker")
-      (p (@ (class "row"))
-         "This is a web frontend to the Guix patch tracker.  Send email to "
-         (a (@ (href ,(string-append "mailto:" (%config 'submission-email-address))))
-            ,(%config 'submission-email-address))
-         " to submit your patches.")
-      ,(search-form #:standalone? #t)
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "panel panel-default"))
-        (p (@ (class "panel-body"))
-           (strong "Hint: ")
+(define* (search-widget #:key (text ""))
+  `(div
+    (@ (class "card mb-3"))
+    (div (@ (class "card-body bg-light"))
+         ,(search-form #:standalone? #t #:text text)
+         (details
+          (summary (strong "Hint"))
+          (p
            "Refine your search with filters like "
            (span (@ (class "filter"))
                  "is:open")
                  "submitter:me")
            ", "
            (span (@ (class "filter"))
-                 "date:yesterday..now")
+                 "severity:serious")
            ", "
            (span (@ (class "filter"))
-                 "date:2018-04-01..2018-04-02")
+                 "tag:easy")
            ", "
            (span (@ (class "filter"))
-                 "date:1m..today")
+                 "date:2d..now")
+           ", "
+           (span (@ (class "filter"))
+                 "date:2018-04-01..2018-04-02")
            ", "
            (span (@ (class "filter"))
-                 "mdate:2w..12h")
+                 "date:1m..today")
            ", and "
            (a (@ (href "help#search"))
-              "many more!"))))
-      ;; TODO: do this via JS?
-      ,@(let ((bugs (recent-bugs 5)))
-          (if (null? bugs)
-              '()
-              `((h2 "Recent activity")
-                ,(list-of-bugs bugs))))))))
+              "many more!"))))))
+
+(define* (header #:key (search-bar? #t) title)
+  `(nav
+    (@ (class "sticky-top navbar navbar-expand navbar-light bg-light"))
+    (a (@ (href "/") (class "navbar-brand pt-0 logo navbar-collapse"))
+       (img (@ (src "/img/logo.png") (alt "logo") (height "25"))))
+    ,@(if title
+          `((span (@ (class "navbar-text")) ,title))
+          '())
+    ,@(if search-bar?
+          `(,(search-form))
+          '())))
+
+(define (index)
+  (layout
+   #:body
+   `(,(header #:search-bar? #f)
+     (main
+      (@ (class "container"))
+      (h1 "Guix issue tracker")
+      (p (@ (class "lead"))
+         "This is a web frontend to the Guix patch and bug trackers.  Send email to "
+         (a (@ (href ,(string-append "mailto:" (%config 'submission-email-address))))
+            ,(%config 'submission-email-address))
+         " to submit a patch, or email "
+         (a (@ (href ,(string-append "mailto:" (%config 'submission-bug-email-address))))
+            ,(%config 'submission-bug-email-address))
+         " to submit a bug report.")
+      ,(search-widget)
+
+      (div (@ (class "mt-4 h4")) "Recent activity "
+           (small (a (@ (href "recent")) "(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 (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"))
+       (thead
+        (tr (@ (class "heading"))
+            (th (@ (class "js-sort-number")) "ID")
+            (th "Subject")
+            (th "Date submitted")
+            (th "Status")))
+       (tbody
+        ,@(priority-bugs)))))))
 
 (define (help)
   (layout
-   #:extra-headers
-   ;; Cache for 24 hours.
-   '((cache-control . ((max-age . 86400))))
    #:body
    `(,(header #:search-bar? #f)
      (div
@@ -208,15 +282,45 @@ 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.  "
              (strong "start") " and " (strong "end") " can be one of "
-             (strong "now") ", " (strong "today") ", " (strong "yesterday")
+             (strong "now") ", " (strong "today")
              ", a date in the formats "
              (strong "YYYY-MM-DD") " or " (strong "YYYYMMDD")
              ", or an amount and a unit for a point in the past, such as "
-             (strong "12d") " for 12 days ago. "
+             (strong "12d..") " for 12 days ago. "
              "Supported units are: "
              (strong "h") " (hours), "
              (strong "d") " (days), "
@@ -225,17 +329,17 @@ some examples.")
              (strong "y") " (years)."))
         (tr
          (td (span (@ (class "filter")) "mdate:<start>..<end>"))
-         (td "Issues with comments submitted within the provided
-range.  The supported arguments are the same as for "
-             (span (@ (class "filter")) "date:") "."))))))))
+         (td "This is just like " (span (@ (class "filter")) "date")
+             " except that it also includes comments."))))))))
 
 (define (unknown id)
   (layout
    #:body
    `(,(header)
      (div (@ (class "container"))
-          (h1 "Patch not found")
-          (p "There is no submission with id " (strong ,id))
+          (h1 "Issue not found")
+          (p "There is no submission with id " (strong ,id) ", or we
+failed to process associated messages.")
           (p (a (@ (href "/")) "Try another one?"))))))
 
 (define (error-page message)
@@ -248,196 +352,393 @@ range.  The supported arguments are the same as for "
           ,message
           (p (a (@ (href "/")) "Try something else?"))))))
 
-(define (issue-page bug)
+(define* (issue-page bug #:optional flash-message)
   "Render the conversation for the given BUG."
   (define id (bug-num bug))
-  (define messages (patch-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 messages))
+                                (participants (filter identity messages)))
                         (lambda (a b)
                           (string< (extract-email a)
                                    (extract-email b)))))
-  (define (show-message message-number message previous-subject)
-    `((div
-       (@ (class "row"))
-       (a (@ (id ,(number->string message-number))))
-       (div
-        (@ (class "avatar col-md-1")
-           (style ,(string-append "background-color:"
-                                  (avatar-color (sender-email message)
-                                                (map extract-email parties)))))
-        ,(string-upcase (string-take (sender-name message) 1)))
+  (define sidebar
+    `(ul (@ (id "sidebar")
+             (class "sticky-top flex-column"))
+         ,(map (lambda (message message-number)
+                 `(li
+                   (div
+                    (@ (class "avatar")
+                       (style ,(string-append "background-color:"
+                                              (avatar-color (sender-email message)
+                                                            (map extract-email parties)))))
+                    ,(string-upcase (string-take (sender-name message) 1)))
+                   (span (@ (class "date"))
+                         (a (@ (href ,(string-append "#" (number->string
+                                                          message-number))))
+                            ,(time->string (date message))))))
+               messages
+               (iota (length messages)))))
+  (define issue-details
+    `(span (@ (class "details"))
+           ,(status-tag bug)
+           ,(string-append "Submitted by "
+                           ;; We don't use bug-originator here
+                           ;; because it includes the email address.
+                           ;; We cannot use extract-name on the
+                           ;; return value, because it swallows
+                           ;; non-ASCII characters.
+                           (sender-name (first messages))
+                           ".")
+           (details
+            (@ (class "info"))
+            (summary "Details")
+            (dl
+             (@ (class "stat"))
+             ,@(let ((num (length parties)))
+                 `((dt ,(if (= num 1)
+                            "One participant"
+                            (string-append (number->string num)
+                                           " participants")))
+                   (dd
+                    (ul ,(map (lambda (name)
+                                `(li (span (@ (class "name")))
+                                     ,name))
+                              (map extract-name parties)))))))
+            (dl
+             (@ (class "stat"))
+             (dt "Owner")
+             (dd
+              ,(or (and=> (bug-owner bug) extract-name) "unassigned")))
+            (dl
+             (@ (class "stat"))
+             (dt "Severity")
+             (dd ,(bug-severity bug)))
+            ,@(if (bug-mergedwith bug)
+                  `((dl
+                     (@ (class "stat"))
+                     (dt "Merged with")
+                     (dd (ul ,(map (lambda (id)
+                                     `(li (a (@ (href ,(string-append "/" id)))
+                                             ,id)))
+                                   ;; XXX: This field can either hold a
+                                   ;; string of multiple ids, or a single
+                                   ;; number.  Deal with this mess.
+                                   (match (bug-mergedwith bug)
+                                     ((? string? str)
+                                      (string-split str #\space))
+                                     ((? number? n)
+                                      (list (number->string n)))))))))
+                  '())
+            ,@(if (bug-blocks bug)
+                  `((dl
+                     (@ (class "stat"))
+                     (dt "Blocks")
+                     (dd (ul ,(map (lambda (id)
+                                     `(li (a (@ (href ,(string-append "/" id)))
+                                             ,id)))
+                                   ;; XXX: This field can either hold a
+                                   ;; string of multiple ids, or a single
+                                   ;; number.  Deal with this mess.
+                                   (match (bug-blocks bug)
+                                     ((? string? str)
+                                      (string-split str #\space))
+                                     ((? number? n)
+                                      (list (number->string n)))))))))
+                  '())
+            ,@(if (bug-blockedby bug)
+                  `((dl
+                     (@ (class "stat"))
+                     (dt "Blocked by")
+                     (dd (ul ,(map (lambda (id)
+                                     `(li (a (@ (href ,(string-append "/" id)))
+                                             ,id)))
+                                   ;; XXX: This field can either hold a
+                                   ;; string of multiple ids, or a single
+                                   ;; number.  Deal with this mess.
+                                   (match (bug-blockedby bug)
+                                     ((? string? str)
+                                      (string-split str #\space))
+                                     ((? number? n)
+                                      (list (number->string n)))))))))
+                  '()))))
+  (define comment-box
+    `(div
+      (@ (class "comment-box"))
+      (a (@ (id "comment")))
+      (div
+       (@ (class "avatar")
+          (style "background-color:#bc80bd")) "?")
+      (div
+       (@ (class "message"))
        (div
-        (@ (class "message col-md-11"))
-        (div
-         (@ (class "panel panel-default"))
-         (div
-          (@ (class "panel-heading"))
-          (div
-           (@ (class "from"))
-           (span (@ (class "address")) ,(sender-name message))
-           " wrote on "
-           (span (@ (class "date"))
-                 (a (@ (href ,(string-append "#" (number->string
-                                                  message-number))))
-                    ,(date->string (date message)))))
-          ,@(if (or (string-suffix? (or previous-subject "")
-                                    (or (subject message) ""))
-                    (not (subject message)))
-                '()
-                `((div (@ (class "subject")) ,(subject message))))
-          (div
-           (@ (class "details"))
+        (@ (class "card"))
+        ,@(if (and (mailer-enabled?)
+                   (not (bug-archived bug)))
+              `((form
+                 (@ (action ,(format #f "/issue/~a/comment"
+                                     (number->string id)))
+                    (enctype "multipart/form-data")
+                    (method "POST"))
+                 (input (@ (style "display:none")
+                           (name "validation")
+                           (placeholder "Please leave this empty.")) "")
+                 (input (@ (type "hidden")
+                           (name "timestamp")
+                           (value ,(timestamp!))) "")
+                 (div
+                  (@ (class "card-header"))
+                  (div (@ (class "from"))
+                       (input (@ (class "address form-control")
+                                 (name "from")
+                                 (required "required")
+                                 (placeholder "Your name")) "")))
+                 (div
+                  (@ (class "body card-body"))
+                  (textarea (@ (name "text")
+                               (required "required")
+                               (class "form-control")
+                               (placeholder "Please input your comment..."))
+                            ""))
+                 (div
+                  (@ (class "card-footer"))
+                  (button (@ (class "btn btn-primary")
+                             (type "submit"))
+                          "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"))
+                      (span (@ (class "address")) "Your comment")))
+                (div
+                 (@ (class "body card-body"))
+                 ,(if (bug-archived bug)
+                      '(p "This issue is archived.")
+                      '(p "Commenting via the web interface is
+currently disabled."))
+                 (p "To comment on this conversation "
+                    (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)))))))))))
+  (define (show-message message-number message previous-subject)
+    `((div (@ (class "mb-5"))
+           (a (@ (class "message-anchor")
+                 (id ,(number->string message-number))))
            (div
-            (@ (class "recipients"))
-            (label "Recipients:")
-            ,(map (lambda (address)
-                    `(span (@ (class "address")) ,address))
-                  (recipients message)))
+            (@ (class "avatar")
+               (style ,(string-append "background-color:"
+                                      (avatar-color (sender-email message)
+                                                    (map extract-email parties)))))
+            ,(string-upcase (string-take (sender-name message) 1)))
            (div
-            (@ (class "message-id"))
-            (label "Message-ID:")
-            ,(message-id message))))
-         (div
-          (@ (class "body panel-body"))
-          ,(display-message-body id message-number message)))))
+            (@ (class "message"))
+            (div
+             (@ (class "card"))
+             (div
+              (@ (class "card-header"))
+              (div
+               (@ (class "from"))
+               (div
+                (@ (class "avatar")
+                   (style ,(string-append "background-color:"
+                                          (avatar-color (sender-email message)
+                                                        (map extract-email parties)))))
+                ,(string-upcase (string-take (sender-name message) 1)))
+               (span (@ (class "address")) ,(sender-name message))
+               " wrote "
+               (span (@ (class "date"))
+                     (a (@ (href ,(string-append "#" (number->string
+                                                      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))))
+              (div
+               (@ (class "details"))
+               (div
+                (@ (class "recipients"))
+                (label "Recipients:")
+                ,(map (lambda (address)
+                        `(span (@ (class "address")) ,address))
+                      (recipients message)))
+               (div
+                (@ (class "message-id"))
+                (label "Message-ID:")
+                ,(message-id message))))
+             (div
+              (@ (class "body card-body"))
+              ,(display-message-body id message-number message)))))
       ,@(if (closing? message id)
             '((div
                (@ (class "row event"))
                (div
-                (@ (class "col-md-offset-1 col-md-11 text-center"))
-                (div (@ (class "label label-primary closed")) "Closed"))))
+                (@ (class "col-11 offset-1 text-center"))
+                (div (@ (class "badge badge-primary closed")) "Closed"))))
             '())))
+
+  (if (null? messages) #f
+      (layout
+       #:title (bug-subject* bug)
+       #:body
+       `(,(header #:title (bug-subject* bug))
+         (div
+          (@ (class "container"))
+          ,@(match flash-message
+              (('error . text)
+               `((div (@ (class "alert alert-danger")
+                         (role "alert"))
+                      ,text)))
+              (('info . text)
+               `((div (@ (class "alert alert-info")
+                         (role "alert"))
+                      ,text)))
+              (_ '()))
+          ,sidebar
+          (div
+           (@ (class "title col-12"))
+           (h1 (@ (class "h3")) ,(bug-subject* bug))
+           ,issue-details)
+          (div (@ (class "row"))
+               (div
+                (@ (class "conversation col-12"))
+                ,(map show-message
+                      (iota (length messages))
+                      messages
+                      (cons (bug-subject* bug)
+                            (map subject messages)))
+                ,comment-box)))))))
+
+(define (list-of-bugs bugs)
+  "Return table rows for all BUGS."
+  (map (lambda (bug)
+         (let ((id (number->string (bug-num bug))))
+           `(tr (@ (class ,(bug-severity bug)))
+                (td ,(or id "-"))
+                (td
+                 ,@(if (member (bug-severity bug) '("serious" "important"))
+                       `((svg (@ (xmlns"http://www.w3.org/2000/svg")
+                                 (xmlns:xlink "http://www.w3.org/1999/xlink")
+                                 (viewBox "0 0 14 16")
+                                 (version "1.1")
+                                 (height "1rem")
+                                 (width "1rem")
+                                 (aria-hidden "true"))
+                              (title ,(bug-severity bug))
+                              (path (@ (fill-rule "evenodd")
+                                       (d "\
+M7 2.3c3.14 0 5.7 2.56 5.7 5.7\
+s-2.56 5.7-5.7 5.7A5.71 5.71 0 011.3 8\
+c0-3.14 2.56-5.7 5.7-5.7z\
+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))
+                         (bug-subject* bug)))
+                (td ,(date->string (bug-date bug)))
+                (td ,(status-tag bug)))))
+       bugs))
+
+(define (priority-bugs)
+  (list-of-bugs (sort
+                 (append
+                  (bugs-by-severity "serious" "open")
+                  (bugs-by-severity "important" "open"))
+                 (lambda (a b) (< (bug-num a) (bug-num b))))))
+
+(define* (list-of-recent-issues #:optional (max 100))
   (layout
-   #:title (bug-subject bug)
-   #:extra-headers
-   (cond
-    ((bug-archived bug)
-     ;; Tell browser to cache this for 12 hours.
-     '((cache-control . ((max-age . 43200)))))
-    ((bug-done bug)
-     ;; Tell browser to cache this for 1 hour.
-     '((cache-control . ((max-age . 3600)))))
-    (else '()))
    #:body
-   `(,(header)
+   `(,(header #:search-bar? #f)
      (div
       (@ (class "container"))
-      (div
-       (@ (class "row title col-md-12"))
-       (h1 ,(bug-subject bug))
-       (span (@ (class "details"))
-             ,(status-tag bug)
-             ,(string-append "Submitted by "
-                             ;; We don't use bug-originator here
-                             ;; because it includes the email address.
-                             ;; We cannot use extract-name on the
-                             ;; return value, because it swallows
-                             ;; non-ASCII characters.
-                             (sender-name (first messages))
-                             ".")))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "conversation col-md-9"))
-        ,(let ((msgs (filter (lambda (msg)
-                               ;; Ignore messages
-                               ;; without body, and
-                               ;; internal messages.
-                               (and (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))))
-        (div
-         (@ (class "row comment-box"))
-         (a (@ (id "comment")))
-         (div
-          (@ (class "avatar col-md-1")
-             (style "background-color:#bc80bd")) "?")
-            (div
-          (@ (class "message col-md-11"))
-          (div
-           (@ (class "panel panel-default"))
-           (div
-            (@ (class "panel-heading"))
-            (div (@ (class "from"))
-                 (span (@ (class "address")) "Your comment")))
-           (div
-            (@ (class "body panel-body"))
-            (p "Comments via the web interface are not currently
-supported.  To comment on this conversation "
-               (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)))))))))
-
-       (div
-        (@ (class "info col-md-3"))
-        (div
-         (@ (class "stat"))
-         ,@(let ((num (length parties)))
-             `((label ,(if (= num 1)
-                           "One participant"
-                           (string-append (number->string num)
-                                          " participants")))
-               (ul ,(map (lambda (name)
-                           `(li (span (@ (class "name")))
-                                ,name))
-                         (map extract-name parties))))))
-        (div
-         (@ (class "stat"))
-         (label "Owner")
-         ,(or (and=> (bug-owner bug) extract-name) "unassigned"))
-        (div
-         (@ (class "stat"))
-         (label "Severity")
-         ,(bug-severity bug))
-        (div
-         (@ (class "stat"))
-         (label "Status")
-         ,(status-tag bug))))))))
+      (h1 "Recent 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 (recent-bugs max))))))))
 
-(define (list-of-bugs bugs)
-  "Return a table of BUGS."
-  (if (null? bugs)
-      `(p "Nothing to see here. "
-          (a (@ (href "/"))
-             "Look for something else?"))
-      `(table (@ (class "table-condensed"))
-              (thead
-               (tr (th "ID")
-                   (th "Subject")
-                   (th "Date submitted")
-                   (th "Status")))
-              (tbody
-               ,@(map (lambda (bug)
-                        (let ((id (number->string (bug-num bug))))
-                          `(tr
-                            (td ,(or id "-"))
-                            (td ,(if id
-                                     `(a (@ (href ,(string-append "/issue/" id)))
-                                         ,(bug-subject bug))
-                                     (bug-subject bug)))
-                            (td ,(date->string (bug-date bug)))
-                            (td ,(status-tag bug)))))
-                      bugs)))))
+(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
-   `(,(header)
-     (div (@ (class "container"))
-          ,@(if (null? bugs)
-                `((h1 "No issues found")
-                  (p "We could not find any issues matching your query "
-                     (code ,query) ". "
-                     (a (@ (href "/"))
-                        "Try searching for something else?")))
-                `((h1 "Submissions matching " (code ,query))
-                  ,(list-of-bugs bugs)))))))
+   `(,(header #:search-bar? #f)
+     (div
+      (@ (class "container"))
+      (h1 "Your search for " (code ,query))
+      ,(search-widget #:text query)
+      ,(if (null? bugs)
+           `(div
+             (@ (class "alert alert-warning")
+                (role "alert"))
+             (h4
+              (@ (class "alert-heading"))
+              "Nothing found!")
+             (p "We could not find any issues matching your query "
+                (code ,query) ". "
+                (a (@ (href "/"))
+                   "Try searching for something else?")))
+           `(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 bugs))))))))