6
7
8
9
10
11
12
13
14
15
16
17
|
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
+
+
+
|
;; 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
|
30
31
32
33
34
35
36
37
38
39
40
|
33
34
35
36
37
38
39
40
41
42
43
|
-
+
|
(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)))])
|
58
59
60
61
62
63
64
65
66
67
|
61
62
63
64
65
66
67
68
69
70
71
72
|
+
+
|
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
|
115
116
117
118
119
120
121
122
123
124
|
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
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
[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
|
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
|
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
|
;; 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))))
|
