1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
(define-module (generate-page)
#:use-module (web server)
#:use-module (web request)
#:use-module (web response)
#:use-module (web uri)
#:use-module (sxml simple)
#:use-module (utils)
#:export (respond-main-page))
(define default-css
`(style "body {padding:0px; margin:0px;}
.wrapper { display: flex; }
.column { width:464px; padding:4px; }
.column .attachments img { max-width: 100%; }
.message.success { background-color: lightgreen; }
.message.error { background-color: lightcoral; }"))
(define dark-theme-css
`(style "body {background: #0f0f0f; color: #fafafa}"))
(define* (respond-main-page db current-user #:key
(message '())
(reply-id #f)
(cookie #f)
(cookie-path "/")
(http-headers '())
(html-header-tags '())
(columns #f)
(default-input-headers #t)
(search-content ""))
(define valid-columns (or columns '(("empty page"))))
(define first-column (or (safe-car valid-columns) '()))
(define rest-columns (safe-cdr valid-columns))
(define
value
`(,default-css
;; ,dark-theme-css
(div (@ (class "wrapper"))
(div (@ (class "column"))
,(make-message message)
,first-column)
,(map (lambda (column)
`(div (@ (class "column"))
,column))
rest-columns))))
(respond value
#:html-header-tags html-header-tags
#:http-headers (if cookie
(cons (cons 'set-cookie
(string-append cookie
";path=" cookie-path))
http-headers)
http-headers)))
(define* (respond #:optional body #:key
(status 200)
(title "Captcha examples")
(doctype "<!DOCTYPE html>\n")
(content-type-params '((charset . "utf-8")))
(content-type 'text/html)
(http-headers '())
(html-header-tags '())
(sxml (and body (templatize title html-header-tags body))))
(values (build-response
#:code status
#:headers `((content-type
. (,content-type ,@content-type-params))
,@http-headers))
(lambda (port)
(if sxml
(begin
(if doctype (display doctype port))
(sxml->xml sxml port))))))
(define (make-message message)
(define (message-type) (symbol->string (car message)))
(define (message-text) (cadr message))
(if (or (not message)
(null? message))
'()
`(div (@ (class ,(string-append "message "
(message-type))))
,(message-text))))
(define (templatize title header-tags body)
`(html (head (title ,title)
(link (@ (rel "icon") (href "/file/favicon.png") (type "image/png")))
,@header-tags
)
(body ,@body)))