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