1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
#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)
|
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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
|
#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
racket/string
txexpr
"index.rkt"
"string.rkt"
"tools.rkt"
yarn/path)
(provide (all-defined-out))
(define (root . elems)
(print (validate-txexpr `(test ,@elems)))
(check-title elems)
(serialize-article-placeholder)
`(document ,@(decode-hardwrapped-paragraphs elems)))
;; Customized paragraph decoder replaces single newlines within paragraphs
;; with single spaces instead of <br> tags (allow hard-wrapped paragraphs)
(define (decode-hardwrapped-paragraphs xs)
(define (no-linebreaks xs)
(decode-linebreaks xs " "))
(decode-paragraphs xs 'paragraph #:linebreak-proc no-linebreaks))
;; Set a title if not already set
(define (check-title elems)
(cond
[(and (not (meta-set? 'title))
(pair? elems)
((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 (if (pair? elems) (first-words elems 5) ""))]))
;; Yarn AST:
;; (document Block-Contents)
;; Footnote definitions, index entry keys are stored in the metas
;; Block-Content :=
;; (heading #:level Inline-Contents)
;; | (paragraph Inline-Contents)
|
106
107
108
109
110
111
112
|
(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
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
(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
(define-tag-function (note attrs elems)
(let* ([note-count (update-meta 'note-count add1 0)]
[note-id (string-append (attr-ref attrs 'date) (format "_~a" note-count))]
[maybe-disp (string-split (attr-ref attrs 'disposition ""))]
[the-note (attr-set* `(note ,attrs ,@elems) 'id note-id 'parent (here-output-path))])
(cond
[(> (length maybe-disp) 1)
(set-meta 'disposition `(,(car maybe-disp)
,(string-join (cdr maybe-disp))
,note-id))])
(cons-to-metas-list 'notes the-note)
(serialize-note the-note note-count)
""))
|
