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
  | 
                                  code)
(provide html-root
         html-item
         html-section
         html-subsection
         html-newthought
         html-smallcaps
         html-center
         html-strike
         html-block
         html-blockcode
         html-index
         html-figure
         html-figure-@2x
         html-image-link
         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 "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-block . elements)
  `(section [[class "content-block"]] (div [[class "content-block-main"]] ,@elements)))
 | 
|
>
|
  | 
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
  | 
                                  code)
(provide html-root
         html-item
         html-section
         html-subsection
         html-newthought
         html-caps
         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-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-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-block . elements)
  `(section [[class "content-block"]] (div [[class "content-block-main"]] ,@elements)))
 | 
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
  | 
  (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))
(define (html-say . elems)
  `(@ (dt ,(car elems) (span [[class "x"]] ": ")) (dd ,@(cdr 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 ""])])
 | 
>
>
>
>
>
  | 
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
  | 
  (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 ""])])
 |