Rebol [
Title: "CSSR"
Purpose: "A Style Sheet Dialect that generates CSS"
Version: 0.1.7
Date: 17-Jun-2013
Author: "Christopher Ross-Gill"
Name: 'cssr
Type: 'module
Exports: [to-css]
]
to-css: use [ruleset parser ??][
ruleset: context [
; Values
values: copy []
unset: func [key [word!]][remove-each [k value] values [k = key]]
set: func [key [word!] value [any-type!]][
unset key repend values [key value]
]
; Values that are zero or more
colors: copy []
lengths: copy []
; images: copy []
transitions: copy []
transformations: copy []
; spacing: copy []
enspace: func [value][join " " value]
form-color: func [value [tuple! word!]][
enspace either value/4 [
["rgba(" value/1 "," value/2 "," value/3 "," either integer? value: value/4 / 255 [value][round/to value 0.01] ")"]
][
["rgb(" value/1 "," value/2 "," value/3")"]
]
]
form-number: func [value [number!] unit [word! string! none!]][
enspace case [
value = 0 ["0"]
unit [join value unit]
value [form value]
]
]
form-value: func [values /local value choices][
any [
switch value: take values [
em pt px deg vw vh [form-number take values value]
pct [form-number take values "%"]
* [form-number take values none]
| [","]
radial [enspace ["radial-gradient(" remove form-values values ")"]]
linear [enspace ["linear-gradient(" remove form-values values ")"]]
]
switch type?/word value [
integer! decimal! [form-number value 'px]
pair! [rejoin [form-number value/x 'px form-number value/y 'px]]
time! [form-number value/second 's]
tuple! [form-color value]
string! [enspace mold value]
url! file! [enspace [{url('} value {')}]]
path! [enspace [{url("data:} form value {;base64,} enbase/base take values 64 {")}]]
]
enspace value
]
]
form-transform: func [transform [block!] /local name direction][
; [
; 'translate direction length
; | 'rotate angle opt ['origin percent percent]
; | 'scale [direction number | 1 2 number]
; ]
switch/default take transform [
translate [
enspace [
"translate" uppercase form take transform
"(" next form-value transform ")"
]
]
rotate [
enspace ["rotate(" next form-value transform ")"]
]
scale [
enspace [
"scale" either word? transform/1 [uppercase form take transform][""]
"(" next form-number take transform none either tail? transform [""][
"," form-number take transform none
] ")"
]
]
][keep mold head insert transform name]
]
form-values: func [values [block!]][
rejoin collect [
while [not tail? values][keep form-value values]
]
]
form-property: func [property [word!] values [string! block!] /vendors /inline prefix][
if block? values [values: form-values values]
rejoin collect [
if any [vendors found? find [transition box-sizing transform-style transition-delay] property][
foreach prefix [-webkit- -moz- -ms- -o-][
keep form-property to word! join prefix form property values
]
]
if prefix [insert next values prefix]
keep ["^/^-" property ":" values ";"]
]
]
render: has [value][
; sort/skip values 2
while [value: take lengths][
value: compose [(value)]
case [
not find values 'width [set 'width value]
not find values 'height [set 'height value]
]
]
while [value: take colors][
value: compose [(value)]
case [
not find values 'color [set 'color value]
not find values 'background-color [set 'background-color value]
]
]
rejoin collect [
keep "{"
foreach [property values] values [
case [
find [opacity] property [
if tail? next values [insert values '*]
]
all [
property = 'background-image
find [radial linear] values/1
][
foreach prefix [-webkit- -moz- -ms- -o-][
keep form-property/inline property copy values prefix
]
]
]
switch/default property [][
keep form-property property values
]
]
foreach transform transformations [
transform: form-transform transform
keep form-property/vendors 'transform transform
]
unless empty? transitions [
keep form-property/vendors 'transition rejoin next collect [
foreach transition transitions [
keep ","
keep form-values transition
]
]
]
keep "^/}"
]
]
new: does [
make self [
values: copy []
colors: copy []
lengths: copy []
; dimensions: copy []
; images: copy []
transitions: copy []
transformations: copy []
spacing: copy []
]
]
]
parser: context [
google-fonts-base-url: http://fonts.googleapis.com/css?family=
; Storage
reset?: false
rules: []
google-fonts: []
; Basic Types
zero: use [zero][
[set zero integer! (zero: either zero? zero [[]][[end skip]]) zero]
]
em: ['em number! | zero]
pt: ['pt number!]
px: [opt 'px number!]
deg: ['deg number! | zero]
scalar: ['* number! | zero]
percent: ['pct number! | zero]
vh: ['vh number! | zero]
vw: ['vw number! | zero]
color: [tuple! | named-color]
time: [time!]
pair: [pair!]
binary: [end skip] ; [path! binary!] ; omitted until considered safe
image: [binary | file! | url!]
; Optionals
named-color: [
'aqua | 'black | 'blue | 'fuchsia | 'gray | 'green |
'lime | 'maroon | 'navy | 'olive | 'orange | 'purple |
'red | 'silver | 'teal | 'white | 'yellow
]
text-style: ['bold | 'italic | 'underline]
border-style: ['solid | 'dotted | 'dashed]
transition-attribute: [
'width | 'height | 'top | 'bottom | 'right | 'left | 'z-index
| 'background | 'color | 'border | 'opacity | 'margin
| 'transform | 'font | 'indent | 'spacing
]
list-styles: [
'disc | 'circle | 'square | 'decimal | 'decimal-leading-zero
| 'lower-roman | 'upper-roman | 'lower-greek | 'lower-latin
| 'upper-latin | 'armenian | 'georgian | 'lower-alpha | 'upper-alpha
]
direction: ['x | 'y | 'z]
position-x: ['right | 'left | 'center]
position-y: ['top | 'bottom | 'middle]
position: [position-y | position-x]
positions: [position-y position-x | position-y | position-x]
repeats: ['repeat-x | 'repeat-y | 'repeat ['x | 'y] | 'no-repeat | 'no 'repeat]
font-name: [string! | 'sans-serif | 'serif | 'monospace]
length: [em | pt | px | percent | vh | vw]
angle: [deg]
number: [scalar | number!]
box-model: ['block | 'inline 'block | 'inline-block]
; Capture/Use System
; parse block [mark ... capture (:captured)]
mark: capture: captured: none
use [start extent][
mark: [start:]
capture: [extent: (new-line/all captured: copy/part start extent false)]
]
emit: func [name [word!] value [any-type!]][
value: compose [(value)]
; change all the non-standard words
foreach [from to][
[no repeat] 'no-repeat
[no bold] 'normal
[no italic] 'normal
[no underline] 'none
[inline block] 'inline-block
[line height] 'line-height
][
replace value from to
]
current/set name value
]
emits: func [name [word!]][
emit name captured
]
; The All-Powerful Selector Rule
; Must be a way to simplify this.
selector: use [
dot-word primary qualifier
form-element form-selectors
out selectors selector
][
dot-word: use [word continue][
; Matches only words that begin .something
[
set word word!
(continue: either #"." = take form word [[]][[end skip]])
continue
]
]
primary: [tag! | issue! | dot-word]
qualifier: [primary | get-word!]
form-element: func [element [tag! issue! word! get-word!]][
either tag? element [to string! element][mold element]
]
form-selectors: func [selectors [block!]][
selectors: collect [
parse selectors [
some [mark some qualifier capture (keep/only captured)
| word! capture (keep captured)]
]
]
selectors: collect [
while [find selectors 'and][
keep/only copy/part selectors selectors: find selectors 'and
selectors: next selectors
] keep/only copy selectors
]
selectors: map-each selector selectors [
collect [
foreach selector reverse collect [
while [find selector 'in][
keep/only copy/part selector selector: find selector 'in
keep 'has
selector: next selector
] keep/only copy selector
][keep selector]
]
]
selectors: collect [
foreach selector selectors [
parse selector [
set selector block! (selector: map-each element selector [form-element element])
any [
'with mark block! capture (
selector: collect [
foreach selector selector [
foreach element captured/1 [
keep join selector form-element element
]
]
]
) |
'has mark block! capture (
selector: collect [
foreach selector selector [
foreach element captured/1 [
keep rejoin [selector " " form-element element]
]
]
]
)
]
]
keep/only selector
]
]
rejoin remove collect [
foreach selector selectors [
foreach rule selector [
keep "," keep "^/"
keep rule
]
]
]
]
selector: [
some primary any [
'with some qualifier
| 'in some primary
| 'and selector
]
]
[
mark
some primary any [
'with some qualifier
| 'in some primary
| 'and selector
] capture
(repend rules [form-selectors captured current: ruleset/new])
]
]
; Each of the Properties fully BNFed
property: [
mark box-model capture (emits 'display)
| mark 'border-box capture (emits 'box-sizing)
| 'min some [
'width mark length capture (emits 'min-width)
| 'height mark length capture (emits 'min-height)
]
| 'max some [
'width mark length capture (emits 'max-width)
| 'height mark length capture (emits 'max-height)
]
| mark ['min-width | 'min-height | 'max-width | 'max-height] length capture (emits take captured)
| 'height mark length capture (emits 'height)
| 'margin [
mark [
1 2 [length opt [length | 'auto]]
| pair opt [length | pair]
] capture (emits 'margin)
|
] any [
'top mark length capture (emits 'margin-top)
| 'bottom mark length capture (emits 'margin-bottom)
| 'right mark [length | 'auto] capture (emits 'margin-right)
| 'left mark [length | 'auto] capture (emits 'margin-left)
]
| 'padding [
mark [
1 4 length
| pair opt [length | pair]
] capture (emits 'padding)
|
] any [
'top mark length capture (emits 'padding-top)
| 'bottom mark length capture (emits 'padding-bottom)
| 'right mark [length | 'auto] capture (emits 'padding-right)
| 'left mark [length | 'auto] capture (emits 'padding-left)
]
| 'border any [
mark 1 4 border-style capture (emits 'border-style)
| mark 1 4 color capture (emits 'border-color)
| 'radius [
some [
'top mark 1 2 length capture (
emits 'border-top-left-radius
emits 'border-top-right-radius
)
| 'bottom mark 1 2 length capture (
emits 'border-bottom-left-radius
emits 'border-bottom-right-radius
)
| 'right mark 1 2 length capture (
emits 'border-top-right-radius
emits 'border-bottom-right-radius
)
| 'left mark 1 2 length capture (
emits 'border-top-left-radius
emits 'border-bottom-left-radius
)
| 'top 'right mark 1 2 length capture (emits 'border-top-right-radius)
| 'top 'left mark 1 2 length capture (emits 'border-top-left-radius)
| 'bottom 'right mark 1 2 length capture (emits 'border-bottom-right-radius)
| 'bottom 'left mark 1 2 length capture (emits 'border-bottom-left-radius)
]
| mark 1 2 length capture (emits 'border-radius)
]
| mark 1 4 length capture (emits 'border-width)
]
| ['radius | 'rounded] mark length capture (emits 'border-radius)
| 'rounded (emit 'border-radius [em 0.6])
| 'font any [
mark length capture (emits 'font-size)
| mark some font-name capture (
captured
remove head forskip captured 2 [insert captured '|]
emits 'font-family
)
| mark color capture (emits 'color)
| 'line 'height mark number capture (emits 'line-height)
| 'spacing mark number capture (emits 'letter-spacing)
| 'shadow mark pair length color capture (emits 'text-shadow)
| mark opt 'no 'bold capture (emits 'font-weight)
| mark opt 'no 'italic capture (emits 'font-style)
| mark opt 'no 'underline capture (emits 'text-decoration)
| ['line-through | 'strike 'through] (emit 'text-decoration 'line-through)
]
| 'text 'indent mark length capture (emits 'text-indent)
| 'line 'height mark [length | scalar] capture (emits 'line-height)
| 'spacing mark number capture (emits 'letter-spacing)
| mark opt 'no 'bold capture (emits 'font-weight)
| mark opt 'no 'italic capture (emits 'font-style)
| mark opt 'no 'underline capture (emits 'text-decoration)
| ['line-through | 'strike 'through] (emit 'text-decoration 'line-through)
| 'shadow mark pair length color capture (emits 'box-shadow)
| 'color mark [color | 'inherit] capture (emits 'color)
| mark ['relative | 'absolute | 'fixed] capture (emits 'position) any [
'top mark length capture (emits 'top)
| 'bottom mark length capture (emits 'bottom)
| 'right mark length capture (emits 'right)
| 'left mark length capture (emits 'left)
]
| 'opacity mark number capture (emits 'opacity)
| mark 'nowrap capture (emits 'white-space)
| mark 'center capture (emits 'text-align)
| 'transition any [
mark transition-attribute time opt time capture (
append/only current/transitions captured
)
]
| [
'delay mark time capture (emits 'transition-delay)
| mark time opt time transition-attribute capture (
append/only current/transitions head reverse next reverse captured
)
| mark time capture (emits 'transition)
]
| some [
mark [
'translate direction length
| 'rotate angle opt ['origin percent percent]
| 'scale [['x | 'y] number | 1 2 number]
] capture (append/only current/transformations captured)
]
| mark 'preserve-3d capture (emits 'transform-style)
| 'hide (emit 'display none)
| 'float mark position-x capture (emits 'float)
| 'opaque (emit 'opacity 1)
| mark 'pointer capture (emits 'cursor)
| ['canvas | 'background] any [
mark color capture (emits 'background-color)
| mark [file! | url!] (emits 'background-image)
| mark positions capture (emits 'background-position)
| mark repeats capture (emits 'background-repeat)
| mark ['contain | 'cover] capture (emits 'background-size)
| mark pair capture (
captured: first captured
emit 'background-position reduce [
'pct to integer! captured/x
'pct to integer! captured/y
]
)
]
| mark [
'radial color color capture (
insert at captured 3 '|
)
| 'linear angle color color capture (
insert at tail captured -2 '|
insert at tail captured -1 '|
)
| 'linear opt 'to positions color color capture (
unless 'to = captured/2 [insert next captured 'to]
insert at tail captured -2 '|
insert at tail captured -1 '|
)
] (emits 'background-image)
; | mark binary capture (emits 'background-image) any [
; mark positions capture (emits 'background-position)
; | mark repeats capture (emits 'background-repeat)
; ]
| mark image capture (emits 'background-image) any [
mark positions capture (emits 'background-position)
| mark pair capture (
captured: first captured
emit 'background-position reduce [
'pct to integer! captured/x
'pct to integer! captured/y
]
)
| mark repeats capture (emits 'background-repeat)
| mark ['contain | 'cover] capture (emits 'background-size)
]
| 'no ['list opt 'style | 'bullet] (emit 'list-style-type 'none)
| opt ['list opt 'style | 'bullet] mark list-styles capture (emits 'list-style-type)
| mark ['inside | 'outside] capture (emits 'list-style-position)
; Any Singleton Values
| mark [
length capture (append/only current/lengths captured)
| some color capture (append current/colors captured)
| time capture (emits 'transition)
| pair capture (
emit 'width captured/1/x
emit 'height captured/1/y
)
]
]
; Control
current: value: none
errors: copy []
; Format Description
dialect: [()
opt ['css/reset (reset?: true)]
opt [
'google 'fonts [
some [
copy value [string! any issue!]
(append/only google-fonts value)
|
set value url! (
all [
value: find/match value google-fonts-base-url
append google-fonts value
]
)
]
]
]
[selector | (repend rules [["body"] current: ruleset/new])]
any [
selector | property
| set value skip (append errors rejoin ["MISPLACED TOKEN: " mold value])
]
]
; CSS Reset Stylesheet
reset: to string! decompress 64#{
eJyNU7Fu2zAQncOvIAwUaQ0pkt0mg4x27pBu3YoMpHiSWFOkTFIOnDT/3kfJNtyi
RQKI4pF8vHv37lgseRfjUBVFTwfyjyRvatcX5HVdROdMKOoQCk+BYsEZ53y/vin5
L74uV6tytb5LW/e6Jhuo4tZZ4u+HURpdc+V6oe0HtiwY62JvMi6dOmRc6X3GwyBs
xsUwGIoZd/In1Zh140VPGetWGe/WGB8xPmHcYtxlfIAP4+rtbnSRsPTACriR0uNf
e2cPPQylwDcAq9uM1zpBa6eAVQQWqkFkAk73ONYWwK1UGd+BFT7RDxkLvTCAhuj1
lqbZWYDDKNMPNCLY7oXPGDZGeEEEspGwoVIInCq4dLBHDKMz1jiPmEbIxEGOMTrQ
KJaNJqNCEsFQS1ZlkCsKaRJnMUSdUHEWLjbOARc7EvAdfTIxFDTwUdfpighaTTft
XiAZRVFoE1K6knCHNbodIRrHfPaevII4T26nufUupch6skjNCpTLjXEYEduPEkQC
ijVdDWPfC3/IWNQoG4e9BYdRaQd1wMTxZ3aF3VbbipcbdjWgNtq280I6j4Cz3Tgb
86Cf0ESrsnx33KlQng6tGLHeU0pSmFwY3cKdFIGMtrRhL6xY8q/fv93forfCYMQh
984Qn5oW6XnUAYG49O4xkA8cEv+t2FmpP5Q5qsX+J9GFQkdNUsJHEtXcq4lfql86
SXzzjnTbIbVVOpk7ZD4LUCAezPEdTfcumn2XQJMd/gWoJCFTunwglWimjtydz3bz
VvJUQ15KCl9fby5WJ8dTCybcXKS8dsaIIb3xk3UuYI63XJ+K+sLY3NtVlffuKW9c
PYZcW5uIaIsm+hEPA31eTMVZPLwGm529jsPL7PUb/DXa0OKBf+FvC8Kfj01abk6t
W26ODV1ukOxvKxG8Kj8FAAA=
}
; Output
render: does [
rejoin collect [
keep {/* CSSR Output */^/}
if all [
block? google-fonts
not empty? google-fonts
][
keep "^/@import url ('"
keep mold join google-fonts-base-url collect [
repeat font length? google-fonts [
unless font = 1 [keep "|"]
case [
url? google-fonts/:font [
keep google-fonts/:font
]
block? google-fonts/:font [
keep replace/all mold to url! take google-fonts/:font "%20" "+"
repeat variant length? google-fonts/:font [
keep back change to url! mold google-fonts/:font/:variant either variant = 1 [":"][","]
]
]
]
]
]
keep "');^/"
]
if reset? [
keep "^//** CSS Reset Begin */^/^/"
keep reset
keep "/* CSS Reset End **/^/"
]
keep "^//** CSSR Output Begin */^/^/"
foreach [selector rule] rules [
keep selector
keep " "
keep rule/render
keep "^/"
]
keep "^/^//* CSSR Output End **/^/"
]
]
; Is Modular
new: does [
make parser [
reset?: false
google-fonts: copy []
rules: copy []
errors: copy []
current: ruleset/new
value: none
]
]
]
??: use [mark][[mark: (probe new-line/all copy/part mark 8 false)]]
to-css: func [dialect [file! url! string! block!] /local out][
case/all [
file? dialect [dialect: load dialect]
url? dialect [dialect: load dialect]
string? dialect [dialect: load dialect]
not block? dialect [make error! "No Dialect!"]
]
out: parser/new
if parse dialect out/dialect [
out/render
]
]
]