Commit 93d338fb authored by Taddeüs Kroes's avatar Taddeüs Kroes

Implemented CSS @media queries

parent e31ac97a
......@@ -58,8 +58,6 @@ rule token = parse
| mystring as s { STRING (strip_quotes s) }
| badstring { raise (SyntaxError "bad string") }
| ident as id { IDENT id }
| '#' (name as nm) { HASH nm }
| "@import" { IMPORT_SYM }
......@@ -67,10 +65,16 @@ rule token = parse
| "@media" { MEDIA_SYM }
| "@charset" { CHARSET_SYM }
| "only" { ONLY }
| "not" { NOT }
| "and" { AND }
| ident as id { IDENT id }
| '!' (w | comment)* "important" { IMPORTANT_SYM }
| (num as n) ("em"|"ex"|"px"|"cm"|"mm"|"in"|"pt"|"pc"|"deg"|"rad"|"grad"|
"ms"|"s"|"hz"|"khz"|"%"|ident as u)
"ms"|"s"|"hz"|"khz"|"%"|"dpi"|"dpcm"|ident as u)
{ UNIT_VALUE (float_of_string n, u) }
| num as n { NUMBER (float_of_string n) }
......@@ -80,6 +84,7 @@ rule token = parse
| (ident as fn) '(' { FUNCTION fn }
| '(' { LPAREN }
| ')' { RPAREN }
| '{' { LBRACE }
| '}' { RBRACE }
......
%{
(* CSS grammar based on http://www.w3.org/TR/CSS2/grammar.html *)
(* CSS grammar based on:
* - http://www.w3.org/TR/CSS2/grammar.html
* - http://www.w3.org/TR/css3-mediaqueries/
*)
open Lexing
open Types
let ( |> ) a b = b a
let filter_none l =
let rec filter l = function
| [] -> l
| None :: tl -> filter l tl
| Some hd :: tl -> filter (hd :: l) tl
in
List.rev (filter [] l)
(* TODO: move this to utils *)
let rec filter_none = function
| [] -> []
| None :: tl -> filter_none tl
| Some hd :: tl -> hd :: filter_none tl
type term_t = Term of expr | Operator of string
......@@ -47,8 +48,8 @@
%token <float> NUMBER
%token <float * string> UNIT_VALUE
%token <string> COMBINATOR RELATION STRING IDENT HASH URI FUNCTION
%token RPAREN LBRACE RBRACE LBRACK RBRACK SEMICOL COLON COMMA DOT PLUS MINUS
%token SLASH STAR EOF
%token LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK SEMICOL COLON COMMA DOT PLUS
%token MINUS SLASH STAR ONLY AND NOT EOF
(* Start symbol *)
%type <Types.stylesheet> stylesheet
......@@ -58,6 +59,7 @@
(* list with arbitrary whitespace between elements and separators *)
%inline wslist(sep, x): S? l=separated_list(sep, terminated(x, S?)) { l }
%inline wspreceded(prefix, x): p=preceded(pair(prefix, S?), x) { p }
cd: CDO S? | CDC S? {}
......@@ -68,7 +70,8 @@ stylesheet:
EOF
{ let charset = match charset with None -> [] | Some c -> [c] in
charset @ imports @ statements }
%inline statement:
statement:
| s=ruleset | s=media | s=page
{ s }
......@@ -77,15 +80,35 @@ charset:
{ Charset name }
import:
| IMPORT_SYM S? tgt=string_or_uri media=wslist(COMMA, IDENT) SEMICOL S?
| IMPORT_SYM S? tgt=string_or_uri media=wslist(COMMA, media_type) SEMICOL S?
{ Import (tgt, media) }
%inline string_or_uri:
| str=STRING { Strlit str }
| uri=URI { Uri uri }
media:
| MEDIA_SYM queries=wslist(COMMA, IDENT) LBRACE S? rulesets=ruleset* RBRACE S?
| MEDIA_SYM queries=media_query_list LBRACE S? rulesets=ruleset* RBRACE S?
{ Media (queries, rulesets) }
media_query_list:
| S?
{ [] }
| S? hd=media_query tl=wspreceded(COMMA, media_query)*
{ hd :: tl }
media_query:
| prefix=only_or_not? typ=media_type S? feat=wspreceded(AND, media_expr)*
{ (prefix, Some typ, feat) }
| hd=media_expr tl=wspreceded(AND, media_expr)*
{ (None, None, (hd :: tl)) }
%inline only_or_not:
| ONLY S? { "only" }
| NOT S? { "not" }
%inline media_type:
| id=IDENT { id }
media_expr:
| LPAREN S? feature=media_feature S? value=wspreceded(COLON, expr)? RPAREN S?
{ (feature, value) }
%inline media_feature:
| id=IDENT { id }
page:
| PAGE_SYM S? pseudo=pseudo_page? decls=decls_block
......@@ -96,12 +119,12 @@ pseudo_page:
{ pseudo }
%inline decls_block:
| LBRACE S? hd=declaration? tl=preceded(pair(SEMICOL, S?), declaration?)* RBRACE S?
| LBRACE S? hd=declaration? tl=wspreceded(SEMICOL, declaration?)* RBRACE S?
{ filter_none (hd :: tl) }
ruleset:
| selectors_hd = selector
selectors_tl = preceded(pair(COMMA, S?), selector)*
selectors_tl = wspreceded(COMMA, selector)*
decls = decls_block
{ Ruleset (selectors_hd :: selectors_tl, decls) }
......
......@@ -4,6 +4,8 @@ let tab = " "
let indent = Str.global_replace (Str.regexp "^\\(.\\)") (tab ^ "\\1")
let prefix_space = function "" -> "" | s -> " " ^ s
let rec cat sep fn = function
| [] -> ""
| [hd] -> fn hd
......@@ -14,6 +16,12 @@ let string_of_num n =
then string_of_int (int_of_float n)
else string_of_float n
(* TODO: move this to utils *)
let rec filter_none = function
| [] -> []
| None :: tl -> filter_none tl
| Some hd :: tl -> hd :: filter_none tl
(*
* Pretty-printing
*)
......@@ -43,6 +51,23 @@ let rec string_of_selector = function
| Combinator (left, com, right) ->
string_of_selector left ^ " " ^ com ^ " " ^ string_of_selector right
let string_of_media_feature = function
| (feature, None) -> "(" ^ feature ^ ")"
| (feature, Some value) -> "(" ^ feature ^ ": " ^ string_of_expr value ^ ")"
let string_of_media_query query =
let features_str = cat " and " string_of_media_feature in
match query with
| (None, None, []) -> ""
| (None, Some mtype, []) -> mtype
| (Some pre, Some mtype, []) -> pre ^ " " ^ mtype
| (None, None, features) -> features_str features
| (None, Some mtype, features) -> mtype ^ " and " ^ features_str features
| (Some pre, Some mtype, features) ->
pre ^ " " ^ mtype ^ " and " ^ features_str features
| (Some pre, None, _) ->
failwith "unexpected media query prefix \"" ^ pre ^ "\""
let block body = " {\n" ^ indent body ^ "\n}"
let rec string_of_statement = function
......@@ -50,7 +75,7 @@ let rec string_of_statement = function
cat ", " string_of_selector selectors ^
block (cat "\n" string_of_declaration decls)
| Media (queries, rulesets) ->
"@media " ^ String.concat ", " queries ^
"@media" ^ prefix_space (cat ", " string_of_media_query queries) ^
block (cat "\n\n" string_of_statement rulesets)
| Import (target, []) ->
"@import " ^ string_of_expr target ^ ";"
......@@ -92,12 +117,25 @@ let rec minify_selector = function
| Combinator (left, com, right) ->
minify_selector left ^ com ^ minify_selector right
let minify_media_feature = function
| (feature, None) -> "(" ^ feature ^ ")"
| (feature, Some value) -> "(" ^ feature ^ ":" ^ minify_expr value ^ ")"
let minify_media_query query =
let features_str = cat " and " minify_media_feature in
match query with
| (None, None, features) -> features_str features
| (None, Some mtype, features) -> mtype ^ " and " ^ features_str features
| (Some pre, Some mtype, features) ->
pre ^ " " ^ mtype ^ " and " ^ features_str features
| _ -> string_of_media_query query
let rec minify_statement = function
| Ruleset (selectors, decls) ->
cat "," minify_selector selectors ^
"{" ^ (cat ";" minify_declaration decls) ^ "}"
| Media (queries, rulesets) ->
"@media " ^ String.concat "," queries ^
"@media" ^ prefix_space (cat "," minify_media_query queries) ^
"{" ^ (cat "" minify_statement rulesets) ^ "}"
| Import (target, []) ->
"@import " ^ string_of_expr target ^ ";"
......
......@@ -15,10 +15,13 @@ type selector =
| Simple of string
| Combinator of selector * string * selector
type media_expr = string * expr option
type media_query = string option * string option * media_expr list
type statement =
| Ruleset of selector list * declaration list
(* <selectors> { <declarations> } *)
| Media of string list * statement list
| Media of media_query list * statement list
(* @media <queries> { <rulesets> } *)
| Import of expr * string list
(* @import <target> [<media>]; *)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment