--- /dev/null
+/* 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;
+}
(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
#: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
(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)