diff options
-rw-r--r-- | assets/mumi.scss | 10 | ||||
-rw-r--r-- | mumi/web/view/utils.scm | 21 |
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)) |