1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
+
+
+
|
#lang racket/base
; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.
;; Tag functions used by pollen.rkt when HTML is the output format.
(require (for-syntax racket/base racket/syntax))
(require racket/list
racket/function
racket/draw
racket/class
pollen/decode
pollen/tag
pollen/setup
net/uri-codec
txexpr
"dust.rkt")
(provide html-fn
html-fndef)
|
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
-
+
|
;; (define html-p (default-tag-function 'p)
(define-syntax (provide/define-html-default-tags stx)
(syntax-case stx ()
[(_ TAG ...)
(let ([tags (syntax->list #'(TAG ...))])
(with-syntax ([((HTML-TAG-FUNC HTML-TAG) ...)
(for/list ([htag (in-list tags)])
(list (format-id stx "html-~a" (syntax-e htag)) (syntax-e htag)))])
|
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
+
+
|
html-subsection
html-newthought
html-smallcaps
html-center
html-block
html-blockcode
html-index
html-figure
html-figure-@2x
html-dialogue
html-say
html-verse
html-link
html-url
html-fn
html-fndef
|
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(let* ([title (maybe-attr 'title attrs "")]
[italic? (assoc 'italic attrs)]
[pre-attrs (cond [italic? '([class "verse"] [style "font-style: italic"])]
[else '([class "verse"])])]
[pre-title (cond [(string>? title "") `(p [[class "verse-heading"]] ,title)]
[else ""])])
`(div [[class "poem"]] ,pre-title (pre ,pre-attrs ,@elems))))
;; (Private) Get the dimensions of an image file
(define (get-image-size filepath)
(define bmp (make-object bitmap% filepath))
(list (send bmp get-width) (send bmp get-height)))
;; (Private) Builds a path to an image in the [image-dir] subfolder of the current document's
;; folder, relative to the current document’s folder
(define (image-source basename)
(define here-path (string->path (maybe-meta 'here-path)))
(define-values (_ here-rel-path-parts)
(drop-common-prefix (explode-path (current-project-root))
(explode-path here-path)))
(let* ([folder-parts (drop-right here-rel-path-parts 1)]
[img-path-parts (append folder-parts (list images-folder basename))]
[img-path (apply build-path/convention-type 'unix img-path-parts)])
(path->string img-path)))
(define (html-figure-@2x . elems)
(define src (image-source (car elems)))
(define alt-text (tx-strs `(span ,@(cdr elems))))
(define img-width (car (get-image-size (build-path (current-project-root) src))))
(define style-str (format "width: ~apx" (/ img-width 2.0)))
`(figure (img [[alt ,alt-text] [style ,style-str] [src ,(string-append web-root src)]])
(figcaption ,@(cdr elems))))
(define (html-figure . elems)
(define src (string-append web-root (image-source (car elems))))
(define alt-text (tx-strs `(span ,@(cdr elems))))
`(figure [[class "fullwidth"]]
(img [[alt ,alt-text] [src ,src]])
(figcaption ,@(cdr elems))))
;; There is no way in vanilla CSS to create a selector for “p tags that contain
;; a span of class ‘newthought’”. So we can handle it at the Pollen processing level.
(define (detect-newthoughts block-xpr)
(define (is-newthought? tx) ; Helper function
(and (txexpr? tx)
(eq? 'span (get-tag tx))
|
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
|
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
|
(define (html-fndef . elems)
(hash-set! fn-definitions (format "~a" (first elems)) (rest elems)))
;; Private use (by html-root)
(define (html-footnote-block)
(define note-items
(for/list ([fn-name (in-list (remove-duplicates (reverse fn-names)))])
(let* ([definition-text (or (hash-ref fn-definitions fn-name #f)
'((i "Missing footnote definition!")))]
[backref-count (count (curry string=? fn-name) fn-names)]
[backrefs (for/list ([fnref-num (in-range backref-count)])
`(a [[href ,(string-append "#"
(fn-id fn-name)
(format "~a" (+ 1 fnref-num)))]] "↩"))])
`(li [[id ,(fndef-id fn-name)]] ,@definition-text ,@backrefs))))
|
