Initial commit.
[software/mumi.git] / mumi / web / view / utils.scm
1 ;;; mumi -- Mediocre, uh, mail interface
2 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
3 ;;;
4 ;;; This program is free software: you can redistribute it and/or
5 ;;; modify it under the terms of the GNU Affero General Public License
6 ;;; as published by the Free Software Foundation, either version 3 of
7 ;;; the License, or (at your option) any later version.
8 ;;;
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;;; Affero General Public License for more details.
13 ;;;
14 ;;; You should have received a copy of the GNU Affero General Public
15 ;;; License along with this program. If not, see
16 ;;; <http://www.gnu.org/licenses/>.
17
18 (define-module (mumi web view utils)
19 #:use-module (ice-9 rdelim)
20 #:use-module (srfi srfi-1)
21 #:export (prettify
22 avatar-color))
23
24 ;; TODO: at some point this should tokenize the text, then apply
25 ;; styles, then output sxml, but for now we keep it simple
26 (define (process line)
27 (cond
28 ((string= "---" line)
29 `(span (@ (class "line diff separator")) ,line))
30 ((string-prefix? "diff --git" line)
31 `(span (@ (class "line diff file")) ,line))
32 ((string-prefix? "+" line)
33 `(span (@ (class "line diff addition")) ,line))
34 ((and (string-prefix? "-" line)
35 (not (string= "--" line))
36 (not (string= "-- " line)))
37 `(span (@ (class "line diff deletion")) ,line))
38 ((string-prefix? "@@" line)
39 `(span (@ (class "line diff range")) ,line))
40 ((string-prefix? ">" line)
41 `(span (@ (class "line quote")) ,line))
42 ((or (string-prefix? "Signed-off-by" line)
43 (string-prefix? "Co-authored-by" line))
44 `(span (@ (class "commit attribution")) ,line))
45 ((or (string-prefix? "From: " line)
46 (string-prefix? "Date: " line)
47 (string-prefix? "Subject: " line))
48 `(span (@ (class "commit header")) ,line))
49 ((or (string-prefix? "* " line)
50 (string-prefix? " * " line))
51 `(span (@ (class "commit changelog")) ,line))
52 (else
53 `(span (@ (class "line")) ,line))))
54
55 (define (prettify text)
56 (define result '())
57 (call-with-input-string text
58 (lambda (port)
59 (let loop ((line (read-line port)))
60 (if (eof-object? line) (reverse result)
61 (begin
62 (set! result
63 (cons (process line)
64 (cons '(br) result)))
65 (loop (read-line port))))))))
66
67 (define colors
68 (circular-list "#8dd3c7" "#bebada" "#fb8072"
69 "#80b1d3" "#fdb462" "#b3de69"
70 "#fccde5" "#d9d9d9" "#bc80bd"
71 "#ccebc5" "#ffed6f"))
72
73 (define (avatar-color who participants)
74 (or (and=> (assoc-ref (zip participants colors) who)
75 first)
76 (first colors)))