Commit 660009a0 authored by Taddeüs Kroes's avatar Taddeüs Kroes

Changed the way shorthand generation works so that the result is closer to the source

parent 0ca0aa97
...@@ -120,5 +120,3 @@ TODO / bugs ...@@ -120,5 +120,3 @@ TODO / bugs
generating the shortest possible representation of the resulting box model. generating the shortest possible representation of the resulting box model.
- `border:none` could be `border:0`, or in general any shorthand that has both - `border:none` could be `border:0`, or in general any shorthand that has both
a `style` and `width` property should be transformed from `none` into `0`. a `style` and `width` property should be transformed from `none` into `0`.
- `padding: 0 !important` is expanded to 4 directions because of the
`!important`
...@@ -4,10 +4,16 @@ ...@@ -4,10 +4,16 @@
open Types open Types
open Util open Util
module SS = Set.Make(String)
let pattern = Str.regexp ("^\\(background\\|border\\|font\\|list-style" ^ module KM = Map.Make(struct
"\\|outline\\|padding\\|margin\\)-\\(.*\\)$") type t = string * bool
let compare a b =
match a, b with
| (_, false), (_, true) -> -1
| (_, true), (_, false) -> 1
| (base_a, _), (base_b, _) -> String.compare base_a base_b
end)
let order = function let order = function
| "background" -> ["color"; "image"; "repeat"; "attachment"; "position-x"; | "background" -> ["color"; "image"; "repeat"; "attachment"; "position-x";
...@@ -20,74 +26,68 @@ let order = function ...@@ -20,74 +26,68 @@ let order = function
| "padding" -> ["top"; "right"; "bottom"; "left"] | "padding" -> ["top"; "right"; "bottom"; "left"]
| _ -> failwith "not a shorthand property" | _ -> failwith "not a shorthand property"
let rec decls_mem name = function let fold_box_dims = function
| [] -> false | [top; right; bottom; left]
| (nm, _, _) :: _ when nm = name -> true when top = bottom && right = left && top = right -> [top]
| _ :: tl -> decls_mem name tl | [top; right; bottom; left] when top = bottom && right = left -> [top; right]
| [top; right; bottom; left] when right = left -> [top; right; bottom]
(* find the value of the last declaration of some property (since the earlier | dims -> dims
* values are overridden), unless an earlier !important value was found *)
let decls_find name decls =
let rec wrap known must_be_imp = function
| [] ->
known
| (nm, value, false) :: tl when nm = name && not must_be_imp ->
wrap (Some value) false tl
| (nm, value, true) :: tl when nm = name ->
wrap (Some value) true tl
| _ :: tl ->
wrap known must_be_imp tl
in
match wrap None false decls with
| None -> raise Not_found
| Some value -> value
let fold base decls = let fold group base =
let rec filter = function let group_mem name =
| [] -> [] let rec mem = function
| [] -> false
| (nm, _, _) :: _ when nm = name -> true
| _ :: tl -> mem tl
in
mem group
in
(* `font-size` and `line-height` are slash-separated in `font` *) let group_find name =
| "size" :: tl when base = "font" && decls_mem "line-height" decls -> let rec wrap known = function
let font_size = decls_find "font-size" decls in | [] ->
let line_height = decls_find "line-height" decls in (match known with Some value -> value | None -> raise Not_found)
Nary ("/", [font_size; line_height]) :: filter tl | (nm, value, _) :: tl when nm = name ->
wrap (Some value) tl
| _ :: tl ->
wrap known tl
in
wrap None group
in
| name :: tl when decls_mem (base ^ "-" ^ name) decls -> let exists sub = group_mem (base ^ "-" ^ sub) in
decls_find (base ^ "-" ^ name) decls :: filter tl let find sub = group_find (base ^ "-" ^ sub) in
| _ :: tl -> filter tl let rec lookup = function
| [] -> []
(* `font-size` and `line-height` are slash-separated in `font` *)
| "size" :: tl when base = "font" && group_mem "line-height" ->
Nary ("/", [find "size"; group_find "line-height"]) :: lookup tl
| name :: tl when exists name -> find name :: lookup tl
| _ :: tl -> lookup tl
in in
filter (order base)
let shorten_box_dims = function match base with
| [top; right; bottom; left]
when top = bottom && right = left && top = right -> [top]
| [top; right; bottom; left] when top = bottom && right = left -> [top; right]
| [top; right; bottom; left] when right = left -> [top; right; bottom]
| dims -> dims
let shorten decls = function
(* `font-size` and `font-family` are required for `font` *) (* `font-size` and `font-family` are required for `font` *)
| "font" when decls_mem "font-size" decls && decls_mem "font-family" decls -> | "font" when exists "size" && exists "family" ->
Some (Concat (fold "font" decls)) Some (Concat (lookup (order "font")))
(* `border-style` is required for `border` *) (* `border-style` is required for `border` *)
| "border" when decls_mem "border-style" decls -> | "border" when exists "style" ->
Some (Concat (fold "border" decls)) Some (Concat (lookup (order "border")))
(* others require at least one property, which is the case when this function (* others require at least one property, which is already the case when this
* is called *) * function is called *)
| ("background" | "list-style" | "outline") as base -> | ("background" | "list-style" | "outline") as base ->
Some (Concat (fold base decls)) Some (Concat (lookup (order base)))
(* margin and padding can only be shorthanded when all directions are known, (* margin and padding can only be shorthanded when all directions are known,
* merging into even shorter shorthands is done by `shorten_box_dims` *) * merging into even shorter shorthands is done by `fold_box_dims` *)
| ("margin" | "padding") as base when | "margin" | "padding"
let has dir = decls_mem (base ^ "-" ^ dir) decls in when exists "top" && exists "right" && exists "bottom" && exists "left" ->
has "top" && has "right" && has "bottom" && has "left" -> let dirs = [find "top"; find "right"; find "bottom"; find "left"] in
let get dir = decls_find (base ^ "-" ^ dir) decls in Some (Concat (fold_box_dims dirs))
Some (Concat (shorten_box_dims [get "top"; get "right";
get "bottom"; get "left"]))
| _ -> None | _ -> None
...@@ -234,45 +234,57 @@ let rec unfold = function ...@@ -234,45 +234,57 @@ let rec unfold = function
| hd :: tl -> | hd :: tl ->
hd :: unfold tl hd :: unfold tl
let make_shorthands decls = let pattern = Str.regexp ("^\\(background\\|border\\|font\\|list-style" ^
"\\|outline\\|padding\\|margin\\)-\\(.*\\)$")
let rec make_shorthands decls =
(* unfold currently existing shorthands into separate properties for merging (* unfold currently existing shorthands into separate properties for merging
* with override properties that are defined later on *) * with override properties that are defined later on *)
(*let decls = unfold decls in (*let decls = unfold decls in
XXX: done by main function for correct pruning of duplicate declarations*) XXX: done by main function for correct pruning of duplicate declarations*)
(* find shorthand names for which properties are present *) let rec extract_groups decl_skipped groups rest =
let rec find_props = function let rec find_in_group name = function
| [] -> SS.empty | [] -> false
| (name, value, false) :: tl when Str.string_match pattern name 0 -> | (nm, _, _) :: _ when nm = name -> true
| _ :: tl -> find_in_group name tl
in
let should_skip base name imp =
try find_in_group name (KM.find (base, imp) groups)
with Not_found -> false
in
let add base imp value =
let key = base, imp in
let group = try KM.find key groups with Not_found -> [] in
KM.add key (value :: group) groups
in
function
| [] -> decl_skipped, groups, rest
| (("line-height", _, imp) as hd) :: tl
when should_skip "font" "line_height" imp ->
extract_groups true groups (hd :: rest) tl
| (("line-height", _, imp) as hd) :: tl ->
extract_groups decl_skipped (add "font" imp hd) rest tl
| ((name, _, imp) as hd) :: tl when Str.string_match pattern name 0 ->
let base = Str.matched_group 1 name in let base = Str.matched_group 1 name in
let sub = Str.matched_group 2 name in let sub = Str.matched_group 2 name in
if List.mem sub (order base) let skip_this = should_skip base name imp in
then SS.add base (find_props tl) if not skip_this && List.mem sub (order base)
else find_props tl then extract_groups decl_skipped (add base imp hd) rest tl
| _ :: tl -> find_props tl else extract_groups (decl_skipped || skip_this) groups (hd :: rest) tl
| hd :: tl -> extract_groups decl_skipped groups (hd :: rest) tl
in in
let try_shorthands = find_props decls in let decl_skipped, groups, rest = extract_groups false KM.empty [] decls in
(* try to generate shorthands for the matched base properties *) let replace (base, important) group tl =
let rec replace base tl = match fold (List.rev group) base with
match shorten decls base with | Some short_value -> (base, short_value, important) :: tl
| None -> tl | None -> group @ tl
| Some short_value -> (base, short_value, false) :: tl
in in
let shorthands = SS.fold replace try_shorthands [] in let shorthands = KM.fold replace groups [] in
(* filter out the original, partial properties, and append the shorthands *) let decls = List.rev_append rest shorthands in
let keep_prop = function if decl_skipped then make_shorthands decls else decls
| ("line-height", _, _) ->
not (decls_mem "font" shorthands)
| (name, _, important) ->
important ||
not (Str.string_match pattern name 0) ||
let base = Str.matched_group 1 name in
let sub = Str.matched_group 2 name in
not (List.mem sub (order base)) || not (decls_mem base shorthands)
in
List.filter keep_prop decls @ shorthands
let compress = let compress =
Util.transform_stylesheet begin function Util.transform_stylesheet begin function
......
...@@ -254,18 +254,15 @@ let sort_stylesheet = ...@@ -254,18 +254,15 @@ let sort_stylesheet =
in in
let rec cmp a b = let rec cmp a b =
match split a, split b with match split a, split b with
| Some (stem_a, tail_a), Some (stem_b, tail_b) -> | Some (base_a, sub_a), Some (base_b, sub_b) when base_a = base_b ->
begin cmp sub_a sub_b
match String.compare stem_a stem_b with | Some (base_a, _), Some (base_b, _) ->
| 0 -> cmp tail_a tail_b String.compare base_a base_b
| n -> n | Some (base_a, _), None when base_a = b -> 1
end | Some (base_a, _), None -> String.compare base_a b
| Some (stem_a, tail_a), None -> | None, Some (base_b, _) when a = base_b -> -1
String.compare stem_a b | None, Some (base_b, _) -> String.compare a base_b
| None, Some (stem_b, tail_b) -> | None, None -> String.compare a b
String.compare a stem_b
| None, None ->
String.compare a b
in in
let cmp_decls (a, _, _) (b, _, _) = cmp a b in let cmp_decls (a, _, _) (b, _, _) = cmp a b in
Statement (Ruleset (selectors, List.stable_sort cmp_decls decls)) Statement (Ruleset (selectors, List.stable_sort cmp_decls decls))
......
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