◊(Local Yarn Code "Diff")

Differences From Artifact [a6c4e837]:

To Artifact [43d9d1e5]:


24
25
26
27
28
29
30

31
32
33
34
35
36
37
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38







+







;; Tag functions used by pollen.rkt when HTML is the output format.

(require (for-syntax racket/base racket/syntax))
(require racket/list
         racket/function
         pollen/decode
         pollen/tag
         net/uri-codec
         txexpr
         "dust.rkt")

(provide html-fn
         html-fndef)

;; Customized paragraph decoder replaces single newlines within paragraphs
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
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







+

+
+
+













+

+
+
+

+

-
+








-
+







+
+
+
+
+
+
+
+
+
+

-
+



-
+

-
+







(provide html-root
         html-item
         html-section
         html-subsection
         html-newthought
         html-smallcaps
         html-center
         html-block
         html-blockcode
         html-index
         html-dialogue
         html-say
         html-verse
         html-link
         html-url
         html-fn
         html-fndef
         html-note)

(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-smallcaps (default-tag-function 'span #:class "smallcaps"))
(define html-center (default-tag-function 'div #:style "text-align: center"))
(define html-dialogue (default-tag-function 'dl #:class "dialogue"))

(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 elements
    (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
                     #:string-proc (compose1 smart-quotes smart-dashes)
                     #:exclude-tags '(script style pre code)))
  `(body ,@second-pass ,(html-footnote-block)))
  `(body ,@second-pass))

(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 . elems)
  `(a [[id ,(here-id (list "_idx-" (uri-encode (car elems))))]
       [href ,(string-append "/keyword-index.html#" (uri-encode (string-downcase (car elems))))]
       [data-index-entry ,(car elems)]
       [class "index-link"]]
      ,@(cdr elems)))

(define (html-say . elems)
  `(@ (dt ,(car elems) (span [[class "x"]] ": ")) (dd ,@(cdr elems))))

(define (html-verse attrs elems)
  (let* ([title  (or (assoc 'title attrs) "")]
  (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)]
         [pre-title (cond [(string>? title "") `(p [[class "verse-heading"]] ,title)]
                          [else ""])])
    `(div [[class "poem"]] (pre ,pre-attrs ,pre-title ,@elems))))
    `(div [[class "poem"]] ,pre-title (pre ,pre-attrs ,@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))
188
189
190
191
192
193
194
195

208
209
210
211
212
213
214

215







-
+
                                                                    (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 attrs elems)
  (txexpr 'note attrs (decode-paragraphs elems #:force? #t)))
  (txexpr 'note attrs (decode-hardwrapped-paragraphs elems)))