#lang at-exp racket/base
(require scribble/html (for-syntax racket/base syntax/name syntax/parse)
"utils.rkt" "resources.rkt")
(define-for-syntax (process-contents who layouter stx xs)
(let loop ([xs xs] [kws '()] [id? #f])
(syntax-case xs ()
[(k v . xs) (keyword? (syntax-e #'k))
(loop #'xs (list* #'v #'k kws) (or id? (eq? '#:id (syntax-e #'k))))]
[_ (with-syntax ([layouter layouter]
[(x ...) (reverse kws)]
[(id ...)
(if id?
'()
(let ([name (or (syntax-property stx 'inferred-name)
(syntax-local-name))])
(if name (list '#:id `',name) '())))]
;; delay body, allow definitions
[body #`(λ () (begin/text #,@xs))])
#'(layouter id ... x ... body))])))
(define (get-path who id file sfx dir)
(define file*
(or file
(let ([f (and id (symbol->string (force id)))])
(cond [(and f (regexp-match #rx"[.]" f)) f]
[(and f sfx)
(string-append f (regexp-replace #rx"^[.]?" sfx "."))]
[else (error who "missing `#:file', or `#:id'~a"
(if sfx "" " and `#:suffix'"))]))))
(if dir (web-path dir file*) file*))
;; The following are not intended for direct use, see
;; `define+provide-context' below (it could be used with #f for the
;; directory if this ever gets used for a flat single directory web
;; page.)
;; for plain text files
(define-syntax (plain stx)
(syntax-case stx () [(_ . xs) (process-contents 'plain #'plain* stx #'xs)]))
(define (plain* #:id [id #f] #:suffix [suffix #f]
#:dir [dir #f] #:file [file #f]
#:referrer [referrer values]
#:newline [newline? #t]
content)
(resource/referrer (get-path 'plain id file suffix dir)
(file-writer output (list content (and newline? "\n")))
referrer))
;; page layout function
(define-syntax (page stx)
(syntax-case stx () [(_ . xs) (process-contents 'page #'page* stx #'xs)]))
(define preamble
@list{
@doctype['html]
@; paulirish.com/2008/conditional-stylesheets-vs-css-hacks-answer-neither/
@comment{[if lt IE 7]>