| ︙ | | |
14
15
16
17
18
19
20
21
22
23
24
|
14
15
16
17
18
19
20
21
22
23
24
25
|
-
+
+
|
(except-in pollen/core select) ; avoid conflict with deta
)
(require "dust.rkt" "cache.rkt" "snippets-html.rkt")
(provide parse-and-cache-article!)
(provide parse-and-cache-article!
cache-index-entries-only!)
(define current-title (make-parameter #f))
(define current-excerpt (make-parameter #f))
(define current-notes (make-parameter '()))
(define current-disposition (make-parameter ""))
|
| ︙ | | |
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
|
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
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
[listing-short (html$-article-listing-short pagenode pubdate title-html)]
[listing-full (string-append header doc-html footer)]
[listing-excerpt (match (current-excerpt)
[#f listing-full]
[(var e) (string-append header (html$-article-excerpt pagenode e) footer)])]
[notes-section-html (cache-notes! pagenode title-plain (current-notes))])
(cache-index-entries! pagenode doc) ; note original doc is used here
(delete-article! pagenode)
(insert-one! (cache-conn)
(make-cache:article
#:page pagenode
#:title-plain title-plain
#:title-html-flow title-html
#:title-specified? title-specified?
#:published pubdate
#:updated (maybe-meta 'updated)
#:author (maybe-meta 'author default-authorname)
#:conceal (maybe-meta 'conceal)
#:series-page series-node
#:noun-singular (maybe-meta 'noun (current-series-noun))
#:note-count (length (current-notes))
#:content-html doc-html
#:disposition (current-disposition)
#:disp-html-anchor (current-disp-id)
#:listing-full-html listing-full
#:listing-excerpt-html listing-excerpt
#:listing-short-html listing-short))
[notes (extract-notes pagenode title-plain (current-notes))]
[notes-section-html (html$-notes-section (map cadr notes))])
(thread
(lambda ()
(call-with-transaction
(cache-conn)
(lambda ()
(cache-index-entries! pagenode doc) ; note original doc is used here
(query-exec (cache-conn)
(delete (~> (from cache:note #:as n)
(where (= n.page ,(symbol->string pagenode))))))
(apply insert! (cache-conn) (map car notes))
(delete-article! pagenode)
(insert-one! (cache-conn)
(make-cache:article
#:page pagenode
#:title-plain title-plain
#:title-html-flow title-html
#:title-specified? title-specified?
#:published pubdate
#:updated (maybe-meta 'updated)
#:author (maybe-meta 'author default-authorname)
#:conceal (maybe-meta 'conceal)
#:series-page series-node
#:noun-singular (maybe-meta 'noun (current-series-noun))
#:note-count (length (current-notes))
#:content-html doc-html
#:disposition (current-disposition)
#:disp-html-anchor (current-disp-id)
#:listing-full-html listing-full
#:listing-excerpt-html listing-excerpt
#:listing-short-html listing-short))))))
(values title-plain (string-append header doc-html notes-section-html footer))))
(define (check-for-poem-title doc-txpr)
(match (car (get-elements doc-txpr))
[(txexpr 'div
|
| ︙ | | |
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
-
+
-
-
-
-
-
-
+
+
-
-
-
+
|
(string-join (list series-part disp-part notes-part))]
[else ""]))
;; ~~~ Notes ~~~
(define (cache-notes! pagenode parent-title note-txprs)
(define (extract-notes pagenode parent-title note-txprs)
(query-exec (cache-conn) (delete (~> (from cache:note #:as n)
(where (= n.page ,(symbol->string pagenode))))))
(cond [(not (null? note-txprs))
(define note-htmls
(for/list ([n (in-list note-txprs)])
(cache-note! n pagenode parent-title)))
(html$-notes-section note-htmls)]
[else ""]))
(define (cache-note! note-tx pagenode parent-title-plain)
(define (make-note note-tx pagenode parent-title-plain)
(define-values (_ attrs elems) (txexpr->values note-tx))
(define disposition-attr (maybe-attr 'disposition attrs))
(define note-date (maybe-attr 'date attrs))
;; Check required attributes
|
| ︙ | | |
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
note-date
note-srcline
content-html
author
author-url)])
(insert-one! (cache-conn)
(make-cache:note
#:page pagenode
#:html-anchor note-id
#:title-html-flow title-html
#:title-plain (tx-strs title-tx)
#:published note-date
#:author author
#:author-url author-url
#:disposition disposition-attr
#:series-page (current-series-pagenode)
#:conceal (or (maybe-attr 'conceal attrs #f) (maybe-meta 'conceal))
#:content-html content-html
#:listing-full-html listing-full
#:listing-excerpt-html listing-full
#:listing-short-html ""))
(html$-note-in-article note-id note-date content-html author author-url)))
(list
(make-cache:note
#:page pagenode
#:html-anchor note-id
#:title-html-flow title-html
#:title-plain (tx-strs title-tx)
#:published note-date
#:author author
#:author-url author-url
#:disposition disposition-attr
#:series-page (current-series-pagenode)
#:conceal (or (maybe-attr 'conceal attrs #f) (maybe-meta 'conceal))
#:content-html content-html
#:listing-full-html listing-full
#:listing-excerpt-html listing-full
#:listing-short-html "")
(html$-note-in-article note-id note-date content-html author author-url))))
(define (make-note-title pagenode parent-title-plain)
`(note-title "Re: " (a [[class "cross-reference"]
[href ,(format "~a~a" web-root pagenode)]]
,parent-title-plain)))
|
| ︙ | | |
261
262
263
264
265
266
|
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(append (for/list ([etx (in-list entry-txs)]) (txexpr->index-entry etx pagenode))
(current-metas-keyword-entries pagenode)))
(delete-index-entries! pagenode)
(save-cache-things! all-entries))
|
