◊(Local Yarn Code "pollen.rkt at [a770b922]")

File pollen.rkt artifact cbfc059e part of check-in a770b922


#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
         racket/function
         "tags-html.rkt"
         "snippets-html.rkt"
         "crystalize.rkt")

(provide (all-defined-out)
         (all-from-out "crystalize.rkt" "snippets-html.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 cache-watchlist
    (map resolve-module-path
         (list tags-html.rkt
               snippets-html.rkt
               dust.rkt
               crystalize.rkt))))

(case (current-poly-target)
  [(html) (spell-of-summoning!)])

;; 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 p)
(poly-branch-tag i)
(poly-branch-tag em)
(poly-branch-tag b)
(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 link)
(poly-branch-tag url)
(poly-branch-tag fn)
(poly-branch-tag fndef)

(poly-branch-kwargs-tag note)
(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"]

;; 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 ...)]))