summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--assets/css/screen.css26
-rw-r--r--mumi/web/view/utils.scm162
2 files changed, 133 insertions, 55 deletions
diff --git a/assets/css/screen.css b/assets/css/screen.css
index 1d7b764..97b6034 100644
--- a/assets/css/screen.css
+++ b/assets/css/screen.css
@@ -221,6 +221,15 @@ details {
margin-top: .5em;
}
+.message details {
+ border-top: 2px dotted #efefef;
+ border-bottom: 2px dotted #efefef;
+}
+.message details summary {
+ color: #586069;
+ padding: 1em 0;
+}
+
.message .body pre {
background: transparent;
border: none;
@@ -306,24 +315,25 @@ details {
.message span.line {
white-space: pre-wrap;
font-family: monospace;
+ display: block;
}
/* diff styles */
-.message span.line.diff.file {
+.message .diff span.line.diff.file {
color: #005cc5;
}
-.message span.line.diff.separator {
+.message .diff span.line.diff.separator {
color: #005cc5;
}
-.message span.line.diff.addition {
+.message .diff span.line.diff.addition {
color: #22863a;
background-color: #f0fff4;
}
-.message span.line.diff.deletion {
+.message .diff span.line.diff.deletion {
color: #b31d28;
background-color: #ffeef0;
}
-.message span.line.diff.range {
+.message .diff span.line.diff.range {
color: #6f42c1;
font-weight: bold;
}
@@ -343,12 +353,12 @@ details {
}
/* quote styles */
-.message span.line.quote {
+.message .quote span.line {
color: #3868cc;
}
-.message span.line.cut-here {
- color: #888;
+.message .snippet {
+ background-color: #fbfbfb;
}
.filter {
diff --git a/mumi/web/view/utils.scm b/mumi/web/view/utils.scm
index 782f737..ab42b88 100644
--- a/mumi/web/view/utils.scm
+++ b/mumi/web/view/utils.scm
@@ -23,6 +23,7 @@
#:use-module (ice-9 receive)
#:use-module (ice-9 iconv)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (syntax-highlight)
#:use-module (syntax-highlight scheme)
@@ -33,58 +34,125 @@
avatar-color
display-message-body))
-;; TODO: at some point this should tokenize the text, then apply
-;; styles, then output sxml, but for now we keep it simple
-(define (process line context)
- (cond
- ((string-prefix? "--8<---------------cut here" line)
- (values `(span (@ (class "line cut-here")) ,line) #f))
- ((and (member 'diff context)
- (string= "---" line))
- (values `(span (@ (class "line diff separator")) ,line) #f))
- ((string-prefix? "diff --git" line)
- (values `(span (@ (class "line diff file")) ,line) 'diff))
- ((and (member 'diff context)
- (string-prefix? "+" line))
- (values `(span (@ (class "line diff addition")) ,line) #f))
- ((and (member 'diff context)
- (string-prefix? "-" line)
- (not (string= "--" line))
- (not (string= "-- " line)))
- (values `(span (@ (class "line diff deletion")) ,line) #f))
- ((and (member 'diff context)
- (string-prefix? "@@" line))
- (values `(span (@ (class "line diff range")) ,line) #f))
- ((string-prefix? ">" line)
- (values `(span (@ (class "line quote")) ,line) #f))
- ((or (string-prefix? "Signed-off-by" line)
- (string-prefix? "Co-authored-by" line))
- (values `(span (@ (class "commit attribution")) ,line) #f))
- ((or (string-prefix? "From: " line)
- (string-prefix? "Date: " line)
- (string-prefix? "Subject: " line))
- (values `(span (@ (class "commit header")) ,line) 'commit))
- ((and (member 'commit context)
- (or (string-prefix? "* " line)
- (string-prefix? " * " line)))
- (values `(span (@ (class "commit changelog")) ,line) #f))
- (else
- (values `(span (@ (class "line")) ,line) #f))))
+(define-record-type <block>
+ (make-block type lines)
+ block?
+ (type block-type)
+ (lines block-raw-lines set-block-lines!))
+
+(define (block-lines block)
+ (reverse (block-raw-lines block)))
+
+(define (add-block-line! block line)
+ (set-block-lines! block
+ (cons line (block-raw-lines block)))
+ block)
+
+(define (process line blocks context)
+ "Process the current LINE. Add it to the latest block in BLOCKS or
+add it to a new block, dependent on CONTEXT. Return the blocks along
+with the next context."
+ (match blocks
+ ((block . other-blocks)
+ (cond
+ ((string-null? line)
+ (values (cons (add-block-line! block `(br))
+ other-blocks)
+ context))
+ ((eq? context 'snippet)
+ (values (cons (add-block-line! block
+ `(span (@ (class "line")) ,line))
+ other-blocks)
+ (if (string-prefix? "--8<---------------cut here" line)
+ #f context)))
+ ((eq? context 'diff)
+ (if (string= "--" line)
+ ;; Retry
+ (process line blocks #f)
+ ;; Format line and add to current block
+ (let ((formatted-line
+ (cond
+ ((string= "---" line)
+ `(span (@ (class "line diff separator")) ,line))
+ ((string-prefix? "+" line)
+ `(span (@ (class "line diff addition")) ,line))
+ ((and (string-prefix? "-" line)
+ (not (string= "--" line))
+ (not (string= "-- " line)))
+ `(span (@ (class "line diff deletion")) ,line))
+ ((string-prefix? "@@" line)
+ `(span (@ (class "line diff range")) ,line))
+ (else
+ `(span (@ (class "line")) ,line)))))
+ (values (cons (add-block-line! block formatted-line)
+ other-blocks)
+ context))))
+ ((eq? context 'quote)
+ (if (string-prefix? ">" line)
+ ;; Add line to current block
+ (values (cons (add-block-line! block
+ `(span (@ (class "line")) ,line))
+ other-blocks)
+ context)
+ ;; Retry
+ (process line blocks #f)))
+ (else
+ (let ((new-context
+ (cond
+ ((string-prefix? "diff --git" line)
+ 'diff)
+ ((string-prefix? ">" line)
+ 'quote)
+ ((string-prefix? "--8<---------------cut here" line)
+ 'snippet)
+ (else 'text)))
+ (formatted-line
+ (cond
+ ((or (string-prefix? "Signed-off-by" line)
+ (string-prefix? "Co-authored-by" line))
+ `(span (@ (class "line commit attribution")) ,line))
+ ((or (string-prefix? "From: " line)
+ (string-prefix? "Date: " line)
+ (string-prefix? "Subject: " line))
+ `(span (@ (class "line commit header")) ,line))
+ ((or (string-prefix? "* " line)
+ (string-prefix? " * " line))
+ `(span (@ (class "line commit changelog")) ,line))
+ ((string-prefix? "diff --git" line)
+ `(span (@ (class "line diff file")) ,line))
+ (else
+ `(span (@ (class "line")) ,line)))))
+ (if (eq? new-context context)
+ (values (cons (add-block-line! block formatted-line)
+ other-blocks)
+ context)
+ (values (cons (make-block new-context (list formatted-line))
+ blocks)
+ new-context))))))))
(define (prettify text)
"Read each line of TEXT and apply PROCESS to it."
(let ((res (fold (lambda (line acc)
- (match acc
- ((#:result res #:context context)
- (receive (processed new-context)
- (process line context)
- `(#:result ,(cons* '(br) processed res)
- #:context ,(if new-context
- (cons new-context context)
- context))))))
- '(#:result () #:context ())
+ (call-with-values
+ (lambda ()
+ (process line
+ (cadr (memq #:blocks acc))
+ (cadr (memq #:context acc))))
+ (lambda (new-blocks new-context)
+ `(#:blocks ,new-blocks #:context ,new-context))))
+ (list #:blocks (list (make-block 'text '()))
+ #:context 'text)
(string-split text #\newline))))
- (reverse (and=> (memq #:result res) cadr))))
+ (map (lambda (block)
+ (if (eq? 'text (block-type block))
+ `(div (@ (class ,(format #f "block ~a" (block-type block))))
+ ,(block-lines block))
+ `(details (@ (class ,(format #f "block ~a" (block-type block)))
+ (open "open"))
+ (summary ,(format #f "Toggle ~a (~a lines)" (block-type block)
+ (length (block-raw-lines block))))
+ ,(block-lines block))))
+ (reverse (cadr (memq #:blocks res))))))
(define colors
(circular-list "#8dd3c7" "#bebada" "#fb8072"