You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
beautiful-racket/br/scribble-xexpr.rkt

41 lines
1.7 KiB
Racket

9 years ago
#lang at-exp br
(require scribble/manual scribble/core txexpr)
(provide scribble->xexpr)
(define (style->attrs s style-accessor)
(let* ([style-datum (style-accessor s)])
(if (style? style-datum) ; either style struct, or simple symbol name
`((style ,(~a (style-name style-datum)))
(properties ,(string-join (map ~a (style-properties style-datum)) " ")))
`((style ,(~a style-datum))))))
;; Unfortunately there seems to be no generic way of fetching the style & elements from a Scribble structure
;; the specific struct accessors must be used.
(define #'structure->txexpr
(λ(stx)
(syntax-match stx
[#'(_ structure-name elem-name id)
(syntax-let ([#'structure-name-elem-name (format-id stx "~a-~a" #'structure-name #'elem-name)]
[#'structure-name-style (format-id stx "~a-style" #'structure-name)])
#'(let* ([elem-raw (structure-name-elem-name id)]
[elems (map scribble->xexpr (if (list? elem-raw)
(flatten elem-raw)
(list elem-raw)))])
(list* 'structure-name (style->attrs id structure-name-style) elems)))])))
(define (scribble->xexpr s)
(cond
[(nested-flow? s) (structure->txexpr nested-flow blocks s)]
[(paragraph? s) (structure->txexpr paragraph content s)]
[(element? s) (structure->txexpr element content s)]
[else s]))
(module+ test
(require rackunit)
(define-simple-check (check-sx? s)
(check-true (txexpr? (scribble->xexpr s))))
(check-sx? @racketblock[(list +)])
(check-sx? @racket[(list +)])
(check-sx? @code{(list +)}))