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
|
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
|
+
-
-
+
+
-
-
+
+
-
+
|
(map resolve-module-path '("tags-html.rkt"
"snippets-html.rkt"
"dust.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-tag stx)
;;
(define-syntax (poly-branch-kwargs-tag stx)
(syntax-parse stx
[(_ TAG:id)
(with-syntax ([((POLY-TARGET POLY-FUNC) ...)
(for/list ([target (in-list (setup:poly-targets))])
(list target (format-id stx "~a-~a" target #'TAG)))]
[DEFAULT-FUNC (format-id stx "html-~a" #'TAG)])
#'(define-tag-function (TAG attributes elems)
(define args (cons attributes elems))
(case (current-poly-target)
[(POLY-TARGET) (apply POLY-FUNC args)] ...
[else (apply DEFAULT-FUNC args)])))]))
;; Like above, but uses define instead of define-tag-function, so arguments
;; are given ‘straight’ rather than being parsed out as attributes.
;; 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-func stx)
(define-syntax (poly-branch-tag stx)
(syntax-parse stx
[(_ TAG:id)
(with-syntax ([((POLY-TARGET POLY-FUNC) ...)
(for/list ([target (in-list (setup:poly-targets))])
(list target (format-id stx "~a-~a" target #'TAG)))]
[DEFAULT-FUNC (format-id stx "html-~a" #'TAG)])
#'(define (TAG . args)
|
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
-
+
-
-
-
-
+
+
+
+
-
+
|
(poly-branch-tag newthought)
(poly-branch-tag smallcaps)
(poly-branch-tag center)
(poly-branch-tag section)
(poly-branch-tag subsection)
(poly-branch-tag code)
(poly-branch-tag blockcode)
(poly-branch-tag verse) ; [#:title ""] [#:italic "no"]
(poly-branch-kwargs-tag verse) ; [#:title ""] [#:italic "no"]
(poly-branch-func link)
(poly-branch-func url)
(poly-branch-func fn)
(poly-branch-func fndef)
(poly-branch-tag link)
(poly-branch-tag url)
(poly-branch-tag fn)
(poly-branch-tag fndef)
(poly-branch-tag note)
(poly-branch-kwargs-tag note)
;; 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)
|