◊(Local Yarn Code "Check-in [4ac3f95c]")

Overview
Comment:Start on new markup and renderer
Timelines: family | ancestors | descendants | both | evolve
Files: files | file ages | folders
SHA3-256: 4ac3f95c1671d6eb4ce1d8f34e62c3bb367c7a29aa93594f73aeeadaceaa7315
User & Date: joel on 2022-04-05 19:19:32.694
Other Links: branch diff | manifest | tags
Context
2022-04-11
18:32
Shuffle stuff, serialize notes Leaf check-in: cf83a366 user: joel tags: evolve
2022-04-05
19:19
Start on new markup and renderer check-in: 4ac3f95c user: joel tags: evolve
2021-11-28
19:19
Clean house check-in: 43a06b90 user: joel tags: evolve
Changes
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
#lang pollen

◊; Copyright 2019 by Joel Dueck. All Rights Reserved.

◊(define-meta published "2019-04-11")

◊title{What Should People Do With Old Journals?}

When I die, I’ll leave behind a lot of ◊index{journals} and notebooks. These may be of
interest to my immediate family, but they won’t exactly be great leisure reading. The only obvious
choices are to keep them in a box in the attic, or eventually throw them out.



There ought to be a third choice. Even the most mundane journal has great value simply because it
contains lots of historical information about current thinking, lifestyle habits, values, and events,
things which change wildly over long time periods.

On the receiving end, suppose you inherit your great-grandfather’s journal; he has been dead for
decades and you never knew him personally. If you can find the time, you pore over it for an hour or
two, deciphering the handwriting. You learn some facts about him and how he looked at things. What
happens after that?

I have an idea that there should be an ◊index[#:key "archives"]{archive}, a public repository for
things like this. You could send in your great-grandfather’s journal for use by future historians.
They would digitize or transcribe it, analyze it, and tag it with metadata about who wrote it, when
they wrote it, and generally what topics they wrote about. They could allow you to specify that it
must remain private until a specified date, and provide you with a digital copy, or even a nice hard
copy if you wanted to pay a little extra.

This would give researchers a huge resource to draw upon, and allow the full value of old journals








|


>
>





|


|

|







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
#lang pollen

◊; Copyright 2019 by Joel Dueck. All Rights Reserved.

◊(define-meta published "2019-04-11")

◊title{What Should People Do With Old Journals?}

When I die, I’ll leave behind a lot of ◊pin{journals} and notebooks. These may be of
interest to my immediate family, but they won’t exactly be great leisure reading. The only obvious
choices are to keep them in a box in the attic, or eventually throw them out.

A ◊def{journal} is a collection of personal observations.

There ought to be a third choice. Even the most mundane journal has great value simply because it
contains lots of historical information about current thinking, lifestyle habits, values, and events,
things which change wildly over long time periods.

◊blockquote[#:caption "hi"]{On the receiving end, suppose you inherit your great-grandfather’s journal; he has been dead for
decades and you never knew him personally. If you can find the time, you pore over it for an hour or
two, deciphering the handwriting. You learn some facts about him and how he looked at things. What
happens after that?}

I have an idea that there should be an ◊pin[#:key "archives"]{archive}, a public repository for
things like this. You could send in your great-grandfather’s journal for use by future historians.
They would digitize or transcribe it, analyze it, and tag it with metadata about who wrote it, when
they wrote it, and generally what topics they wrote about. They could allow you to specify that it
must remain private until a specified date, and provide you with a digital copy, or even a nice hard
copy if you wanted to pay a little extra.

This would give researchers a huge resource to draw upon, and allow the full value of old journals
︙︙
Name change from pollen.rkt to pollen-old.rkt.
Modified pollen.rkt from [92b6e46e] to [295a2ae6].
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
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
145
146
147
#lang racket/base

; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.

;; Functions for tags and template content used in all Pollen source files and templates.

(require (for-syntax "targets.rkt"
                     racket/base
                     racket/syntax
                     syntax/parse))

(require pollen/tag
         pollen/setup
         "cache.rkt"
         "tags-html.rkt"
         "snippets-html.rkt"
         "crystalize.rkt")

(provide (all-defined-out)
         (all-from-out "crystalize.rkt" "snippets-html.rkt" "cache.rkt"))

(module setup racket/base
  (require "targets.rkt"
           syntax/modresolve
           racket/runtime-path
           pollen/setup)
  (provide (all-defined-out))
  (define poly-targets targets)
  (define allow-unbound-ids? #f)
  
  (define block-tags (append '(title style dt note) default-block-tags))

  (define-runtime-path tags-html.rkt     "tags-html.rkt")
  (define-runtime-path snippets-html.rkt "snippets-html.rkt")
  (define-runtime-path dust.rkt          "dust.rkt")
  (define-runtime-path crystalize.rkt    "crystalize.rkt")
  (define-runtime-path cache.rkt         "cache.rkt")
  (define-runtime-path series-list.rkt   "series-list.rkt")
  (define cache-watchlist
    (map resolve-module-path
         (list tags-html.rkt
               snippets-html.rkt
               dust.rkt
               cache.rkt
               series-list.rkt
               crystalize.rkt))))

;; Macro for defining tag functions that automatically branch based on the 
;; current output format and the list of poly-targets in the setup module.
;; Use this macro when you know you will need keyword arguments.
;;
(define-syntax (poly-branch-kwargs-tag stx)
  (syntax-parse stx
    [(_ TAG:id)
     (with-syntax ([((POLY-TARGET POLY-FUNC) ...) 
                    (for/list ([target (in-list targets)])
                              (list target (format-id stx "~a-~a" target #'TAG)))]
                   [DEFAULT-FUNC (format-id stx "html-~a" #'TAG)])
       #'(define-tag-function (TAG attributes elems)
           (case (current-poly-target)
             [(POLY-TARGET) (POLY-FUNC attributes elems)] ... 
             [else (DEFAULT-FUNC attributes elems)])))]))

;; Like above, but uses `define` instead of `define-tag-function`.
;; Use this when you know you will not need keyword arguments.
;;
(define-syntax (poly-branch-tag stx)
  (syntax-parse stx
    [(_ TAG:id)
     (with-syntax ([((POLY-TARGET POLY-FUNC) ...) 
                    (for/list ([target (in-list targets)])
                              (list target (format-id stx "~a-~a" target #'TAG)))]
                   [DEFAULT-FUNC (format-id stx "html-~a" #'TAG)])
       #'(define (TAG . args)
           (case (current-poly-target)
             [(POLY-TARGET) (apply POLY-FUNC args)] ...
             [else (apply DEFAULT-FUNC args)])))]))

;; Define all the tag functions
(poly-branch-tag root)

(poly-branch-tag title)
(poly-branch-tag excerpt)
(poly-branch-tag excerpt*)
    
(poly-branch-tag p)
(poly-branch-tag i)
(poly-branch-tag em)
(poly-branch-tag b)
(poly-branch-tag mono)
(poly-branch-tag strong)
(poly-branch-tag strike)
;(poly-branch-tag color)
(poly-branch-tag ol)
(poly-branch-tag ul)
(poly-branch-tag item)
(define li item) ; useful alias :-P
(poly-branch-tag sup)
(poly-branch-tag blockquote)
(poly-branch-tag newthought)
(poly-branch-tag sep)
(poly-branch-tag caps)
(poly-branch-tag center)
(poly-branch-tag section)
(poly-branch-tag subsection)
(poly-branch-tag code)
(poly-branch-tag dialogue)
(poly-branch-tag say)
(poly-branch-tag saylines)
(poly-branch-tag magick)  ; Extra-fancy ligatures, “long s”
(poly-branch-kwargs-tag index)
(poly-branch-tag figure)
(poly-branch-tag figure-@2x)
(poly-branch-tag image-link)
(poly-branch-kwargs-tag blockcode)
(poly-branch-kwargs-tag verse)          ; [#:title ""] [#:italic "no"]
(poly-branch-tag attrib)

(poly-branch-tag link)
(poly-branch-tag url)
(poly-branch-tag xref)
(poly-branch-tag fn)
(poly-branch-tag fndef)

(poly-branch-kwargs-tag note-with-srcline)
(poly-branch-tag block)

;; Not yet implemented
; (poly-branch-tag table)         ; #:columns ""
; (poly-branch-tag inline-math)
; (poly-branch-tag margin-note)
; (poly-branch-tag noun)
; (poly-branch-func index-entry entry)
; (poly-branch-tag spot-illustration) ; #:src "img--sans-path.png" [#:has-print-version? "yes"]


(define-syntax (note stx)
  (syntax-parse stx
    [(_ args ...)
     (with-syntax ([srcline (number->string (syntax-line stx))])
       #'(note-with-srcline #:srcline srcline args ...))]))

;; My pet shortcut for for/splice. Greatly cuts down on parentheses for the
;; most common use case (looping through a single list).
(define-syntax (for/s stx)
  (syntax-case stx ()
    [(_ thing listofthings result-expr ...)
     #'(for/splice ([thing (in-list listofthings)]) result-expr ...)]))


|
<
|
<
|
<
<
|
|

<
<
<
<
<
<
|
|
|

<
<
<
<
|
|
<
<
<
|

<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
|
<
<
<
<
<
<
|
|
|
<

|
<
>
|
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

<
<
<
<
|
|
<
<
|
<
<
<
<
<
<
<
|
>
|
|
<
<
<
|
<
<
<
<
<
<
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






#lang racket/base

(require pollen/decode

         txexpr

         yarn/markup


         yarn/string
         yarn/tools)







(provide
 (all-defined-out)
 (all-from-out yarn/markup))





(module+ setup
  (provide block-tags)



  (define block-tags blocks-elements))















;; Customized paragraph decoder replaces single newlines within paragraphs















;; with single spaces instead of <br> tags. Allows for “semantic line wrapping”.



(define (decode-hardwrapped-paragraphs xs)






  (define (no-linebreaks xs)
    (decode-linebreaks xs " "))
  (decode-paragraphs xs 'paragraph #:linebreak-proc no-linebreaks))


(define (root . elems)

  (validate-txexpr `(test ,@elems))
  (check-title elems)


  `(document ,@(decode-hardwrapped-paragraphs elems)))





































(define (check-title elems)
  (cond


    [(and (not (meta-set? 'title))







          ((tx-is? 'poetry #:has-attrs 'title) (car elems)))
     (set-meta 'title (format "‘~a’" (attr-ref (car elems) 'title)))
     (set-meta 'title-supplied? #t)]
    [(not (meta-set? 'title))



     (set-meta 'title (first-words elems 5))]))






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
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
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
215
216
217

218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287

288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310

311
312
313
#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
         pollen/core
         net/uri-codec
         txexpr
         "dust.rkt")

(provide html-fn
         html-fndef)

;; Customized paragraph decoder replaces single newlines within paragraphs
;; with single spaces instead of <br> tags. Allows for “semantic line wrapping”.
(define (decode-hardwrapped-paragraphs xs)
  (define (no-linebreaks xs)
    (decode-linebreaks xs " "))
  (decode-paragraphs xs #:linebreak-proc no-linebreaks))

;; A shortcut macro: lets me define a whole lot of tag functions of the form:
;;  (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)))])
         #'(begin
             (provide HTML-TAG-FUNC ...)
             (define HTML-TAG-FUNC (default-tag-function 'HTML-TAG)) ...)))]))

;; Here we go:
(provide/define-html-default-tags p
                                  b
                                  strong
                                  i


                                  em
                                  ol
                                  ul
                                  sup
                                  blockquote
                                  code)

(provide html-root
         html-title
         html-excerpt
         html-excerpt*
         html-item
         html-section
         html-subsection
         html-newthought
         html-sep
         html-caps
         html-mono
         html-center
         html-strike
         html-block
         html-blockcode
         html-index
         html-figure
         html-figure-@2x
         html-image-link
         html-dialogue
         html-say
         html-saylines
         html-magick
         html-verse
         html-attrib
         html-link
         html-xref

         html-url
         html-fn
         html-fndef
         html-note-with-srcline)

(define html-item (default-tag-function 'li))
(define html-section (default-tag-function 'h2))
(define html-subsection (default-tag-function 'h3))
(define html-newthought (default-tag-function 'span #:class "newthought"))
(define (html-sep) '(hr [[class "sep"]]))
(define html-caps (default-tag-function 'span #:class "caps"))
(define html-center (default-tag-function 'div #:style "text-align: center"))
(define html-strike (default-tag-function 'span #:style "text-decoration: line-through"))
(define html-dialogue (default-tag-function 'dl #:class "dialogue"))
(define html-mono (default-tag-function 'samp))

(define (html-block . elements)
  `(section [[class "content-block"]] (div [[class "content-block-main"]] ,@elements)))

(define (html-root . elements)
  (invalidate-series)
  (define first-pass
    (decode-elements (append elements (list (html-footnote-block)))
                     #:txexpr-elements-proc decode-hardwrapped-paragraphs
                     #:exclude-tags '(script style figure table pre)))

  (define second-pass
    (decode-elements first-pass
                     #:block-txexpr-proc detect-newthoughts
                     #:inline-txexpr-proc decode-link-urls
                     #:exclude-tags '(script style pre code)))
  `(body ,@second-pass))

(define (html-title . elements) `(title ,@elements))
(define (html-excerpt . elements) `(excerpt ,@elements))
(define (html-excerpt* . elements) `(excerpt* ,@elements))

(define (html-blockcode attrs elems)
  (define file (or (assoc 'filename attrs) ""))
  (define codeblock `(pre [[class "code"]] (code ,@elems)))
  (cond [(string>? file "") `(@ (div [[class "listing-filename"]] 128196 " " ,file) ,codeblock)]
        [else codeblock]))

(define (html-index attrs elems)
  (define index-key (maybe-attr 'key attrs (tx-strs `(span ,@elems))))
  `(a [[id ,(here-id (list "_idx-" (uri-encode index-key)))]
       [href ,(string-append "/keyword-index.html#" (uri-encode (string-downcase index-key)))]
       [data-index-entry ,index-key]
       [class "index-link"]]
      ,@elems))

;; To be used within ◊dialogue
(define (html-say . elems)
  `(@ (dt ,(car elems) (span [[class "x"]] ": ")) (dd ,@(cdr elems))))

;; Same as ◊say, but preserve linebreaks
(define (html-saylines . elems)
  (apply html-say (decode-linebreaks elems)))

(define (html-verse attrs elems)
  (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))))

(define (html-magick . elems)
  (txexpr
   'div '([class "antique"])
   (decode-elements
    elems
    #:string-proc
    (λ (s) (regexp-replace* #px"(?<!f)s(?![fkb\\s”,;.’:\\!\\?]|$)" s "ſ")))))

(module+ test
  (require rackunit)
  ; always round s at the end of a word
  (check-equal? (html-magick "mirrors? yes, it is") '(div [[class "antique"]] "mirrors? yes, it is"))
  ; always round s before/after f
  (check-equal? (html-magick "offset, satisfaction") '(div [[class "antique"]] "offset, ſatisfaction"))
  ; always LONG s before hyphen
  (check-equal? (html-magick "Shafts-bury") '(div [[class "antique"]] "Shaftſ-bury"))
  ; always round s before k or b (17th-century rules)
  (check-equal? (html-magick "ask, husband") '(div [[class "antique"]] "ask, husband"))
  ; always LONG s everywhere else
  (check-equal? (html-magick "song, substitutes") '(div [[class "antique"]] "ſong, ſubſtitutes")) 

  ;; Nested elements
  (check-equal?
   (html-magick '(root "This is " (a [[href "class"]] (b "song, substitutes"))))
   '(div [[class "antique"]] (root "This is " (a [[href "class"]] (b "ſong, ſubſtitutes"))))))

(define html-attrib (default-tag-function 'div #:class "attrib"))

;; (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))))

;; Simple link to an image
(define (html-image-link . elems)
  (define src (image-source (car elems)))
  (define title (tx-strs `(span ,@(cdr elems))))
  `(a [[href ,(string-append web-root src)] [title ,title]] ,@(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))
         (attrs-have-key? tx 'class)
         (string=? "newthought" (attr-ref tx 'class))))
  (if (and (eq? (get-tag block-xpr) 'p)
           (is-newthought? (first (get-elements block-xpr))))
      (attr-set block-xpr 'class "pause-before")
      block-xpr))

;; Links
;;
;; Private use:
(define all-link-urls (make-hash))

;; Provided tag functions:
(define (html-link . args)
  `(link& [[ref ,(format "~a" (first args))]] ,@(rest args)))

(define (html-url ref url)
  (define page-path (hash-ref (current-metas) 'here-path))
  (define page-link-urls (hash-ref! all-link-urls page-path make-hash))
  (hash-set! page-link-urls (format "~a" ref) url) "")

;; Private use (by html-root):
(define (decode-link-urls tx)
  (define page-path (hash-ref (current-metas) 'here-path))
  (define page-link-urls (hash-ref! all-link-urls page-path make-hash))
  (cond [(eq? (get-tag tx) 'link&)
         (let* ([url-ref (attr-ref tx 'ref)]
                [url (or (hash-ref page-link-urls url-ref #f)
                         (format "Missing reference: ~a" url-ref))])
           `(a [[href ,url]] ,@(get-elements tx)))]
        [else tx]))

;; Fast link to another article
(define html-xref
  (case-lambda
    [(title) `(a [[href ,(format "~aarticles/~a.html" web-root (normalize title))]
                  [class "xref"]]
                 (i ,title))]
    [elems `(a [[href ,(format "~aarticles/~a.html" web-root (first elems))]
                [class "xref"]]
               ,@(rest elems))]))

;; Footnotes
;;
;; Private use:
(define all-fn-names (make-hash))
(define all-fn-definitions (make-hash))
(define (fn-id x) (here-id (string-append x "_fn")))
(define (fndef-id x) (here-id (string-append x "_fndef")))

;; Provided footnote tag functions:
(define (html-fn . args)
  (define name (format "~a" (first args)))
  (define page-path (hash-ref (current-metas) 'here-path))
  (define page-fn-names (cons name (hash-ref! all-fn-names page-path '())))
  (hash-set! all-fn-names page-path page-fn-names)
  
  (let* ([def-anchorlink (string-append "#" (fndef-id name))]
         [nth-ref        (number->string (count (curry string=? name) page-fn-names))]
         [ref-id         (string-append (fn-id name) nth-ref)]
         [fn-number      (+ 1 (index-of (remove-duplicates (reverse page-fn-names)) name))]
         [ref-text       (format "(~a)" fn-number)])
    (cond [(empty? (rest args)) `(sup (a [[href ,def-anchorlink] [id ,ref-id]] ,ref-text))]
          [else `(span [[class "links-footnote"] [id ,ref-id]]
                       ,@(rest args)
                       (sup (a [[href ,def-anchorlink]] ,ref-text)))])))


(define (html-fndef . elems)
  (define page-path (hash-ref (current-metas) 'here-path))
  (define page-fn-defs (hash-ref! all-fn-definitions page-path make-hash))
  (hash-set! page-fn-defs (format "~a" (first elems)) (rest elems)))

;; Private use (by html-root)
(define (html-footnote-block)
  (define page-path (hash-ref (current-metas) 'here-path))
  (define page-fn-names (hash-ref! all-fn-names page-path '()))
  (define page-fn-defs (hash-ref! all-fn-definitions page-path (make-hash)))
  (define note-items
    (for/list ([fn-name (in-list (remove-duplicates (reverse page-fn-names)))])
      (let* ([definition-text (or (hash-ref page-fn-defs fn-name #f)
                                  '((i "Missing footnote definition!")))]
             [backref-count (count (curry string=? fn-name) page-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))))
  (cond [(null? note-items) ""]
        [else `(section ((class "footnotes")) (hr) (ol ,@note-items))]))


(define (html-note-with-srcline attrs elems)
  (txexpr 'note attrs (decode-hardwrapped-paragraphs elems)))





|
>

<
<
<
<
<
|

<
<
|
|
|

|
<

<
<
<
<
<
<
|
<
|
<
<
<
<
<
<
<
<
<
<
|
<
<
|
|
<
>
>
|
<
<
<
|
<
|
<
|
<
<
|
<
<
<
<
<
<
|
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
>
<
<
<
<

<
<
<
<
<
<
<
<
<
<
|
<
<
|
<
|
|
<
<
<
>
|
<
|
|
|
<
|
<
<
<
|
|
<
<
<
<

|
<
<
<
<
<
<
|
<
<
<
|
|
<
<
|
<
<
<
<
<
<
<
<
|
<
|
<
<
|
|
<
|
|
<
<
<
<
<
<
<
<
<
<
<

|
|
<
<
|
<
|
|
|
>
|
<

<
<
|
<
|
<
<
<
<
<
<
|
|
|
<
<
<
<
<

|
<
<
<
<
<

<
|
|
|
<

<
<
>
|
|
<
<
<
<
<
<
<
<
|
<
<
<
|
|
<
|
<

|
|
<
<

<
|
<
<
<
<
<
<
<
<
|
<
<
<
<
|
<
<
<
|

<
<
<
|
<
<
<
|
<
|
<
<
<
<
|
<
<
<
<
<
<
|
<
<
>

|
|
|
<

<
|
|
<
<
|
<
<
<
<
<
<
<
<
<
<
<
>

|
|
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




92



93
94



95



96

97




98






99


100
101
102
103
104

105

106
107


108











109
110
111
112
#lang racket/base

; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.

;; Pollen “tag functions” that return elements of a Yarn AST. This AST can be
;; rendered into HTML or other formats (using, e.g., the yarn/render/html module).






(require pollen/decode
         pollen/tag


         "index.rkt"
         "string.rkt"
         "tools.rkt")

(provide (all-defined-out))








;; Yarn AST:

;;  (document Block-Contents)










;;  Footnote definitions, index entry keys are stored in the metas



;;  Block-Content := 

;;    (heading #:level Inline-Contents)
;;    | (paragraph Inline-Contents)
;;    | (thematic-break style)



;;    | (codeblock info Inline-Contents)

;;    | (blockquote items := (item Block-Contents))

;;    | (poetry title style Block-Contents)


;;    | (itemization style start Block-Contents)






;;    | (dialogue speeches := (speech interlocutor Block-Contents))




;;    | (figure source caption)










;;    | (margin-note Block-Contents)















;;  Inline-Content :=


;;    string?

;;    | (italic Inline-Contents)
;;    | (bold Inline-Contents)



;;    | (link destination Inline-Contents)
;;    | (monospace Inline-Contents)

;;    | (strikethrough Inline-Contents)
;;    | (caps Inline-Contents)
;;    | (image description source)

;;    | (xref type dest-key Inline-Contents)



;;    | (footnote-ref label)
;;    | line-break





(define blocks-elements






  '(heading



    paragraph
    thematic-break


    codeblock








    blockquote

    poetry


    itemization
    dialogue

    figure
    margin-note))












(define inline-elements
  '(italic


    bold

    link
    image
    xref
    footnote-ref
    line-break))




(define (title . t) (set-meta 'title t) (set-meta 'title-supplied? #t) "")

(define (section . s) `(heading [[level "2"]] ,@s))






(define (subsection . s) `(heading [[level "3"]] ,@s))
(define (excerpt . e) (set-meta 'excerpt e))
(define (excerpt* . e) (apply excerpt e) `(@ ,@e))






(define (pause [type 'blank]) `(thematic-break ,type)) ; type = blank | mark







(define codeblock (default-tag-function 'codeblock #:info ""))
(define blockquote (default-tag-function 'blockquote)) ; #:caption
(define figure (default-tag-function 'figure))




(define (i . inline) `(italic ,@inline))
(define em i)
(define (b . inline) `(bold ,@inline))








(define (mono . inline) `(monospace ,@inline))



(define (caps . inline) `(caps ,@inline))
(define (strike . inline) `(strikethrough ,@inline))

(define br 'line-break)


(define (link ref . elems) `(link ,ref ,@elems))
(define (url ref URL) (update-metas-subhash 'urls ref URL) "")




(define (xref type elems k)








  (define key (or k (normalize-key (->text elems))))




  (cons-to-metas-list 'xref-keys key)



  `(xref ,type ,key ,@elems))




(define (pin #:key [key #f] . elems) (xref 'idx elems key))



(define (def #:key [key #f] . elems) (xref 'def elems key))

(define (ref #:key [key #f] . elems) (xref 'ref elems key))











(define (fn ref) `(footnote-ref ,ref))


(define (fndef ref . elems) (update-metas-subhash 'footnote-defs ref elems) "")

(define (ol . elems) `(itemization [[start "1"]] ,@elems))     ; #:style
(define (ul . elems) `(itemization ,@elems))       ; #:style
(define (item . blocks) `(item ,@blocks))



(define (dialogue . speeches) `(dialogue ,@speeches))
(define (say interlocutor elems) `(speech ,interlocutor ,@elems))


(define (saylines interlocutor elems)











  `(speech ,interlocutor ,@(decode-linebreaks elems 'line-break)))

(define verse (default-tag-function 'poetry)) ; #:title, #:style