#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 racket/base
racket/syntax
syntax/parse
pollen/setup))
(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 syntax/modresolve
racket/runtime-path
pollen/setup)
(provide (all-defined-out))
(define poly-targets '(html))
(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 cache-watchlist
(map resolve-module-path
(list tags-html.rkt
snippets-html.rkt
dust.rkt
cache.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 (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)
(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 (setup:poly-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)
(poly-branch-tag sup)
(poly-branch-tag blockquote)
(poly-branch-tag newthought)
(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-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 ...)]))
