diff options
| -rw-r--r-- | assets/css/screen.css | 26 | ||||
| -rw-r--r-- | mumi/web/view/utils.scm | 162 |
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" |