From 05ffaa14b2483e29ab496151a4ae0150bd61607b Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Sat, 24 Dec 2022 19:42:30 +0100
Subject: Accept "plain" query for issue URLs to disable processing of lines.

This is useful for text browsers and for unusually large issues.
---
 assets/mumi.scss        |  6 ++++++
 mumi/web/controller.scm |  9 ++++++++-
 mumi/web/util.scm       | 11 ++++++-----
 mumi/web/view/html.scm  |  4 ++--
 mumi/web/view/utils.scm |  9 ++++++---
 5 files changed, 28 insertions(+), 11 deletions(-)

diff --git a/assets/mumi.scss b/assets/mumi.scss
index de24c4e..22925ab 100644
--- a/assets/mumi.scss
+++ b/assets/mumi.scss
@@ -543,6 +543,12 @@ details {
     display: block;
 }
 
+pre.ugly-body {
+    word-wrap: break-word;
+    margin: 0;
+    white-space: pre-wrap;
+}
+
 /* diff styles */
 div.line pre {
     margin: 0;
diff --git a/mumi/web/controller.scm b/mumi/web/controller.scm
index 8f1db92..028af6f 100644
--- a/mumi/web/controller.scm
+++ b/mumi/web/controller.scm
@@ -102,6 +102,11 @@
     ((or ('GET "issue" (? string->number id))
          ('GET (? string->number id)))
      (let ((bug (bug-status id))
+           (plain? (-> request
+                       request-uri
+                       uri-query
+                       parse-query-string
+                       (cut assoc-ref <> "plain")))
            (message (match (uri-query (request-uri request))
                       ("comment-ok"
                        '(info . "Your comment has been submitted!"))
@@ -124,7 +129,9 @@
                      (cons cookie-header
                            '((cache-control . ((max-age . 3600))))))
                     (else (list cookie-header))))
-                  (page (issue-page bug message)))
+                  (page (issue-page bug
+                                    #:flash-message message
+                                    #:plain? plain?)))
              (if page
                  (render-html page #:extra-headers headers)
                  (render-html (unknown id))))
diff --git a/mumi/web/util.scm b/mumi/web/util.scm
index f3312e4..95fe423 100644
--- a/mumi/web/util.scm
+++ b/mumi/web/util.scm
@@ -39,11 +39,12 @@
 
 (define (parse-query-string query)
   "Parse and decode the URI query string QUERY and return an alist."
-  (let lp ((lst (map uri-decode (string-split query (char-set #\& #\=)))))
-    (match lst
-      ((key value . rest)
-       (cons (cons key value) (lp rest)))
-      (() '()))))
+  (let ((pairs (string-split query #\&)))
+    (fold (lambda (pair acc)
+            (match (map uri-decode (string-split pair #\=))
+              ((key) (cons (cons key "true") acc))
+              ((key value) (cons (cons key value) acc))))
+          '() pairs)))
 
 (define (request-path-components request)
   (split-and-decode-uri-path (uri-path (request-uri request))))
diff --git a/mumi/web/view/html.scm b/mumi/web/view/html.scm
index 55aa45a..e152af7 100644
--- a/mumi/web/view/html.scm
+++ b/mumi/web/view/html.scm
@@ -416,7 +416,7 @@ failed to process associated messages.")
   "Encode PARTS and join them together into an absolute URI path."
   (string-append "/" (encode-and-join-uri-path parts)))
 
-(define* (issue-page bug #:optional flash-message)
+(define* (issue-page bug #:key flash-message plain?)
   "Render the conversation for the given BUG."
   (define id (bug-num bug))
   (define all-messages-with-numbers
@@ -667,7 +667,7 @@ currently disabled."))
            (@ (class "message-id"))
            (label "Message-ID:")
            ,(message-id message))))
-        ,(display-message-body id message-number message)))
+        ,(display-message-body id message-number message plain?)))
       ,@(if (closing? message id)
             '((div
                (@ (class "event"))
diff --git a/mumi/web/view/utils.scm b/mumi/web/view/utils.scm
index 1e52117..d05e4a8 100644
--- a/mumi/web/view/utils.scm
+++ b/mumi/web/view/utils.scm
@@ -233,9 +233,10 @@ V8.5a.5.5 0 011 0V12a2 2 0 01-2 2H2a2 2 0 01-2-2V8.5A.5.5 0 01.5 8z")) "")
                  (clip-rule "evenodd")
                  (d "M8 1a.5.5 0 01.5.5v8a.5.5 0 01-1 0v-8A.5.5 0 018 1z")) "")))
 
-(define (display-message-body bug-num message-number message)
+(define* (display-message-body bug-num message-number message #:optional plain?)
   "Convenience procedure to render MESSAGE (part of bug with number
-BUG-NUM), even when it is a multipart message."
+BUG-NUM), even when it is a multipart message.  Do not prettify
+lines when PLAIN? is #T."
   (define (display-multipart-chunk headers body path)
     (define (attachment-url)
       (string-append "/issue/"
@@ -291,7 +292,9 @@ BUG-NUM), even when it is a multipart message."
               (div (@ (class "download-part"))
                    (a (@ (href ,(attachment-url)))
                       ,download-icon))
-              ,(prettify body message-number))))))
+              ,(if plain?
+                   `(pre (@ (class "ugly-body")) ,body)
+                   (prettify body message-number)))))))
   (define (display-mime-entity entity . path)
     (match entity
       (($ <mime-entity> headers (? string? body))
-- 
cgit v1.2.3