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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
+
+
+
-
+
+
-
-
+
+
+
-
+
-
+
-
+
-
+
-
+
+
+
+
+
+
+
+
-
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
-
+
-
-
-
+
+
+
|
;; -------------------------------------------------------------------------
;; Provides functions for displaying content in HTML templates.
(require pollen/core
pollen/template
pollen/decode
racket/string
racket/function
racket/list
txexpr
openssl/sha1
"dust.rkt")
(provide html$-page-head
html$-page-body-open
html$-article-open
html$-article-close
html$-article-listing-short
html$-page-body-close
html$-note-title
html$-note-contents
html$-note-listing-full
html$-note-in-article
html$-notes-section)
html$-notes-section
html$-paginate-navlinks)
(define (html$-page-head [title #f])
◊string-append{<head>
<title>◊if[title title ""] </title>
<meta charset="utf-8" />
<meta name="viewport" content="width=device-width, initial-scale=1">
<link rel="stylesheet" type="text/css" href="/web-extra/martin.css">
</head>})
(define (html$-page-body-open)
◊string-append{<body><main>
(define (html$-page-body-open [class ""])
(define body-class (if (non-empty-string? class) (format " class=\"~a\"" class) ""))
◊string-append{<body◊|body-class|><main>
<a href="/"><header>
<img src="/web-extra/logo.png" height="103" width="129" class="logo">
<img src="/web-extra/mark.svg" height="103" class="logo">
<h1>The Local Yarn</h1>
</header></a>})
(define (html$-article-open title? title-tx published)
(define (html$-article-open pagenode title? title-tx published)
(cond
[title?
◊string-append{<article class="with-title hentry">
◊(->html `(h1 [[class "entry-title"]] ,@(get-elements title-tx)))
<p class="time"><a href="#" class="rel-bookmark">
<p class="time"><a href="/◊(symbol->string pagenode)" class="rel-bookmark">
<time datetime="◊published" class="published">◊ymd->english[published]</time>
</a></p>
<section class="entry-content">}]
[else
◊string-append{<article class="no-title hentry">
<h1><a href="#" class="rel-bookmark">
<h1><a href="/◊(symbol->string pagenode)" class="rel-bookmark">
<time datetime="◊published" class="entry-title">◊ymd->english[published]</time>
</a></h1>
<section class="entry-content">}]))
(define (html$-article-close footertext)
(cond [(non-empty-string? footertext)
◊string-append{</section>
<footer class="article-info"><span class="x">(</span>◊|footertext|<span class="x">)</span></footer>
</article>}]
[else "</section></article>"]))
(define (html$-note-title author pagenode parent-title)
(define (html$-note-title pagenode parent-title)
(define author-part
(cond [(and (non-empty-string? author)
(not (string-ci=? author default-authorname)))
(format "A note from ~a, " author)]
[else ""]))
(define article-part
(format "Re: <a class=\"cross-reference\" href=\"/~a\">~a</a>"
pagenode
parent-title))
(string-append author-part article-part))
(define-values (first-tag first-attrs first-elems) (txexpr->values (car elems)))
[(block-txexpr? (car elems))
[(and (block-txexpr? (car elems)) (non-empty-string? disposition-mark))
(define-values (first-tag first-attrs first-elems) (txexpr->values (car elems)))
(cons (txexpr first-tag first-attrs (cons disposition first-elems)) (cdr elems))]
[else
(cons disposition elems)]))
(string-append* (map ->html body-elems)))
(define (html$-note-listing-full pagenode note-id title-html-flow date contents [author default-authorname] [author-url ""])
(define author-part
(cond [(non-empty-string? author-url)
◊string-append{
<div class="note-meta">
—<a class="u-author h-card" href="◊|author-url|"><i>◊|author|</i></a>
</div>}]
[else ◊string-append{
<div class="note-meta">
—<span class="h-card"><i>◊|author|</i></span>
</div>}]))
(define maybe-author-class?
(define maybe-author-class
(cond [(string=? author default-authorname) "by-proprietor"]
[else ""]))
◊string-append{
<article class="with-title ◊maybe-author-class? hentry">
<h1 class="entry-title">◊|title-html-flow|</h1>
<p class="time"><a href="◊|pagenode|◊note-id" class="rel-bookmark note-permlink">
<article class="with-title ◊maybe-author-class hentry">
<h1 class="entry-title note-full">◊|title-html-flow|</h1>
<p class="time"><a href="/◊|pagenode|#◊note-id" class="rel-bookmark note-permlink">
<time datetime="◊date">◊ymd->english[date]</time>
</a></p>
<section class="entry-content">
<div class="p-content p-name">◊|contents|</div>
◊author-part
</section>
</article>})
|
155
156
157
158
159
160
161
|
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
</div>})
(define (html$-notes-section note-htmls)
◊string-append{<div class="further-notes" id="furthernotes">
<h2>Further Notes</h2>
◊(apply string-append note-htmls)
</div>})
;; (private) Returns HTML for a list-item link to a particular page in a set of numbered pages
(define (html$-paginate-link basename pagenum [linktext (number->string pagenum)] [class ""])
(define cstr (if (non-empty-string? class) (format " class=\"~a\"" class) ""))
(format "<li~a><a href=\"/~a-pg~a.html\">~a</a></li>" cstr basename pagenum linktext))
;; Returns HTML for a series of list items with links to numbered pages
(define (html$-paginate-navlinks pagenum pagecount basename)
(define slots 9)
(define on-first-group? (<= pagenum (- slots 4)))
(define on-last-group? (>= pagenum (- pagecount slots -4)))
(define only-one-group? (<= pagecount slots))
(define group-start (- pagenum (quotient (- slots 4) 2))) ; not always used!
(define page-func (curry html$-paginate-link basename))
(define page-group-syms
(cond [only-one-group?
`(,@(range 1 (+ 1 pagecount)))]
[on-first-group?
`(,@(range 1 (min (+ 1 pagecount) (- slots 1))) "..." ,pagecount)]
[on-last-group?
`(1 "..." ,@(range (- pagecount slots -3) (+ pagecount 1)))]
[else
`(1
"..."
,@(range group-start (min (+ 1 pagecount) (+ group-start (- slots 4))))
"..."
,pagecount)]))
(define page-group
(for/list ([psym (in-list page-group-syms)])
(cond
[(and (number? psym) (equal? psym pagenum))
(format "<li class=\"current-page\">~a</li>" psym)]
[(number? psym) (page-func psym)]
[else "<li>…</li>"])))
(define prev-link
(if (eq? 1 pagenum)
"<li class=\"nav-text inactive-link\">←Newer</li>"
(page-func (- pagenum 1) "← Newer" "nav-text")))
(define next-link
(if (eq? pagecount pagenum)
"<li class=\"nav-text inactive-link\">Older→</li>"
(page-func (+ pagenum 1) "Older →" "nav-text")))
(string-join `(,prev-link ,@page-group ,next-link)))
|
