diff options
-rw-r--r-- | assets/css/code.css | 33 | ||||
-rw-r--r-- | assets/css/screen.css | 4 | ||||
-rw-r--r-- | guix.scm | 1 | ||||
-rw-r--r-- | mumi/web/view/html.scm | 7 | ||||
-rw-r--r-- | mumi/web/view/utils.scm | 33 |
5 files changed, 64 insertions, 14 deletions
diff --git a/assets/css/code.css b/assets/css/code.css new file mode 100644 index 0000000..c308845 --- /dev/null +++ b/assets/css/code.css @@ -0,0 +1,33 @@ +/* Syntax highlighting code, by David Thompson, borrowed + from: + https://git.dthompson.us/blog.git/blob_plain/refs/heads/haunt-migration:/css/dthompson.css + David Thompson gives permission for this to be GPLv3+ and CC BY-SA 4.0 + + Modified significantly since. +*/ + + +.syntax-special, .syntax-element { + color: #856; + font-weight: bold; +} + +.syntax-symbol { + color: #423; +} + +.syntax-string { + color: #484; +} + +.syntax-keyword, .syntax-attribute { + color: #921; +} + +.syntax-comment { + color: #666; +} + +.syntax-open, .syntax-close { + color: #688; +} diff --git a/assets/css/screen.css b/assets/css/screen.css index 79dd0a3..d26f91e 100644 --- a/assets/css/screen.css +++ b/assets/css/screen.css @@ -151,6 +151,10 @@ table { .multipart.text-x-patch { } +.multipart.scheme { + white-space: pre-wrap; +} + .attachment:before { background-image: url('/img/file.svg'); background-size: 1rem; @@ -135,6 +135,7 @@ Debbugs bug tracker's SOAP service.") (build-system gnu-build-system) (inputs `(("guile-debbugs" ,guile-debbugs-next) + ("guile-syntax-highlight" ,guile-syntax-highlight) ("mailutils" ,mailutils-next) ("guile" ,guile-2.2.4))) (native-inputs diff --git a/mumi/web/view/html.scm b/mumi/web/view/html.scm index 91c9809..5977161 100644 --- a/mumi/web/view/html.scm +++ b/mumi/web/view/html.scm @@ -66,7 +66,12 @@ (@ (rel "stylesheet") (media "screen") (type "text/css") - (href "/css/screen.css")))) + (href "/css/screen.css"))) + (link + (@ (rel "stylesheet") + (media "screen") + (type "text/css") + (href "/css/code.css")))) (body ,@body))) #:extra-headers ,extra-headers)) diff --git a/mumi/web/view/utils.scm b/mumi/web/view/utils.scm index ce2827e..9547f4b 100644 --- a/mumi/web/view/utils.scm +++ b/mumi/web/view/utils.scm @@ -20,6 +20,8 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) + #:use-module (syntax-highlight) + #:use-module (syntax-highlight scheme) #:use-module (debbugs email) #:use-module (mumi messages) #:export (prettify @@ -111,23 +113,28 @@ BUG-NUM), even when it is a multipart message." (string-contains type "application") (first (assoc-ref headers "content-disposition")))) (attachment-name - (or (and=> binary-attachment? + (or (and=> (assoc-ref headers "content-disposition") (lambda (value) - (and=> (string-match "filename=([^ ;]+)" value) + (and=> (string-match "filename=([^ ;]+)" (first value)) (lambda (m) (match:substring m 1))))) "file"))) - (if binary-attachment? - `(div (@ (class "attachment")) - "Attachment: " - (a (@ (href ,(string-append "/issue/" - (number->string bug-num) - "/attachment/" - (number->string (email-msg-num message)) - "/" (string-join (map number->string path) "/")))) - ,attachment-name)) - `(div (@ (class ,(string-join `("multipart" ,(or type ""))))) - ,(prettify body))))) + (cond + (binary-attachment? + `(div (@ (class "attachment")) + "Attachment: " + (a (@ (href ,(string-append "/issue/" + (number->string bug-num) + "/attachment/" + (number->string (email-msg-num message)) + "/" (string-join (map number->string path) "/")))) + ,attachment-name))) + ((string-suffix? ".scm" attachment-name) + `(div (@ (class "multipart scheme")) + ,(highlights->sxml (highlight lex-scheme body)))) + (else + `(div (@ (class ,(string-join `("multipart" ,(or type ""))))) + ,(prettify body)))))) (cond ((multipart-message? message) => (lambda (attributes) |