94 lines
3.2 KiB
Racket
94 lines
3.2 KiB
Racket
#lang racket
|
|
(require xml
|
|
unstable/function
|
|
unstable/text)
|
|
|
|
;; css/c : FlatContract
|
|
;; Recognizes representations of Cascading Style Sheets.
|
|
(define css/c (listof (cons/c text/c (listof (list/c text/c text/c)))))
|
|
|
|
(provide/contract
|
|
[css/c flat-contract?]
|
|
[css? (-> any/c boolean?)]
|
|
[write-css (->* [css/c] [output-port?] void?)])
|
|
|
|
;; A Cascading Style Sheet (CSS) is a (Listof StyleDefn)
|
|
;; A Style Definition (StyleDefn) is a (cons Selectors (Listof PropDefn))
|
|
;; A Selectors is a Selector or a (NonEmptyListof Selector)
|
|
;; A Selector is a Symbol or String
|
|
;; A Property Definition (PropDefn) is a (list PropName PropVal)
|
|
;; A Property Name (PropName) is a Symbol or String
|
|
;; A Property Value (PropVal) is a Symbol or String
|
|
|
|
;; css? : Any -> Boolean
|
|
;; Reports whether a value is a CSS.
|
|
(define css? (flat-contract-predicate css/c))
|
|
|
|
;; write-css : CSS [OutputPort] -> Void
|
|
;; Writes a CSS datastructure as a proper text Cascading Style Sheet.
|
|
(define write-css
|
|
(lambda/parameter (css [output #:param current-output-port])
|
|
(for-each write-style-defn css)))
|
|
|
|
;; write-style-defn : StyleDefn [OutputPort] -> Void
|
|
;; Writes a style definition to a Cascading Style Sheet.
|
|
(define write-style-defn
|
|
(lambda/parameter (style-defn [output #:param current-output-port])
|
|
(write-selector (car style-defn))
|
|
(display " {")
|
|
(for-each write-prop-defn (cdr style-defn))
|
|
(display " }\n")))
|
|
|
|
;; write-text : Text [OutputPort] -> Void
|
|
;; Writes a text field to a Cascading Style Sheet.
|
|
(define write-text
|
|
(lambda/parameter (text [output #:param current-output-port])
|
|
(display (text->string text))))
|
|
|
|
;; write-selector : Selector [OutputPort] -> Void
|
|
;; Writes a selector to a Cascading Style Sheet.
|
|
(define write-selector write-text)
|
|
|
|
;; write-prop-defn : PropDefn [OutputPort] -> Void
|
|
;; Writes a property definition to a Cascading Style Sheet.
|
|
(define write-prop-defn
|
|
(lambda/parameter (prop-defn [output #:param current-output-port])
|
|
(display " ")
|
|
(write-prop-name (car prop-defn))
|
|
(display " : ")
|
|
(write-prop-val (cadr prop-defn))
|
|
(display ";")))
|
|
|
|
;; write-prop-name : PropName [OutputPort] -> Void
|
|
;; Writes a property name to a Cascading Style Sheet.
|
|
(define write-prop-name write-text)
|
|
|
|
;; write-prop-val : PropVal [OutputPort] -> Void
|
|
;; Writes a property value to a Cascading Style Sheet.
|
|
(define write-prop-val write-text)
|
|
|
|
(provide/contract
|
|
[write-xexpr (->* [xexpr/c] [output-port?] void?)])
|
|
|
|
(define write-xexpr
|
|
(lambda/parameter (xexpr [output #:param current-output-port])
|
|
(write-xml/content (xexpr->xml xexpr))))
|
|
|
|
(provide/contract
|
|
[create-webpage (string? xexpr/c . -> . void?)]
|
|
[create-stylesheet (string? css/c . -> . void?)])
|
|
|
|
;; create-stylesheet : String CSS -> Void
|
|
;; Writes an individual stylesheet to a file.
|
|
(define (create-stylesheet filename css)
|
|
(let* ([out-port (open-output-file filename #:exists 'replace)])
|
|
(write-css css out-port)
|
|
(close-output-port out-port)))
|
|
|
|
;; create-webpage : String XExpr -> Void
|
|
;; Writes an individual webpage to a file.
|
|
(define (create-webpage filename xexpr)
|
|
(let* ([out-port (open-output-file filename #:exists 'replace)])
|
|
(write-xexpr xexpr out-port)
|
|
(close-output-port out-port)))
|