summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--assets/mumi.scss10
-rw-r--r--mumi/web/view/utils.scm21
2 files changed, 27 insertions, 4 deletions
diff --git a/assets/mumi.scss b/assets/mumi.scss
index 22925ab..6912a88 100644
--- a/assets/mumi.scss
+++ b/assets/mumi.scss
@@ -537,6 +537,16 @@ details {
display: none;
}
+.truncation-notice:before {
+ display: block;
+ background: linear-gradient(#00000000,var(--card-background-color));
+ height: 20rem;
+ width: 100%;
+ position: relative;
+ content: " ";
+ margin-top: -20rem;
+}
+
.message div.line {
white-space: pre-wrap;
font-family: monospace;
diff --git a/mumi/web/view/utils.scm b/mumi/web/view/utils.scm
index 7ab5ab5..1ce7b64 100644
--- a/mumi/web/view/utils.scm
+++ b/mumi/web/view/utils.scm
@@ -237,6 +237,7 @@ V8.5a.5.5 0 011 0V12a2 2 0 01-2 2H2a2 2 0 01-2-2V8.5A.5.5 0 01.5 8z")) "")
"Convenience procedure to render MESSAGE (part of bug with number
BUG-NUM), even when it is a multipart message. Do not prettify
lines when PLAIN? is #T."
+ (define truncation-limit 20000)
(define (display-multipart-chunk headers body path)
(define (attachment-url)
(string-append "/issue/"
@@ -265,7 +266,10 @@ lines when PLAIN? is #T."
(attachment-name
(or (and=> (assoc-ref headers 'content-disposition)
(cut assoc-ref <> 'filename))
- "file")))
+ "file"))
+ (truncate-text?
+ (and (not attachment?)
+ (> (string-length body) truncation-limit))))
(cond
((or html? hide-attachment?)
`(div (@ (class "attachment"))
@@ -293,9 +297,18 @@ lines when PLAIN? is #T."
(div (@ (class "download-part"))
(a (@ (href ,(attachment-url)))
,download-icon))
- ,(if plain?
- `(pre (@ (class "ugly-body")) ,body)
- (prettify body message-number)))))))
+ ,(cond
+ (plain?
+ `(pre (@ (class "ugly-body")) ,body))
+ (truncate-text?
+ `(,(prettify (string-take body truncation-limit) message-number)
+ (div
+ (@ (class "truncation-notice"))
+ "This message was truncated. "
+ (a (@ (href ,(attachment-url)))
+ "Download the full message here."))))
+ (else
+ (prettify body message-number))))))))
(define (display-mime-entity entity . path)
(match entity
(($ <mime-entity> headers (? string? body))