From a181f88a79280249d9dca92e198139da98fbc81a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Wed, 27 Nov 2024 15:00:02 +0100 Subject: [PATCH 1/2] Scroll positions are now floats Adapt to Dom_html API change (https://github.com/ocsigen/js_of_ocaml/pull/1747). --- eliom.opam | 12 ++++++------ src/lib/client/eliommod_dom.ml | 20 ++++++++++---------- src/lib/client/eliommod_dom.mli | 2 +- 3 files changed, 17 insertions(+), 17 deletions(-) diff --git a/eliom.opam b/eliom.opam index ea1a0b6a39..f58ce20a28 100644 --- a/eliom.opam +++ b/eliom.opam @@ -22,13 +22,13 @@ depends: [ "ocamlfind" "ppx_deriving" "ppxlib" {>= "0.15.0"} - "js_of_ocaml-compiler" {>= "5.5.0"} - "js_of_ocaml" {>= "5.5.0"} - "js_of_ocaml-lwt" {>= "5.5.0"} + "js_of_ocaml-compiler" {>= "6.0.0"} + "js_of_ocaml" {>= "6.0.0"} + "js_of_ocaml-lwt" {>= "6.0.0"} "js_of_ocaml-ocamlbuild" {build} - "js_of_ocaml-ppx" {>= "5.5.0"} - "js_of_ocaml-ppx_deriving_json" {>= "5.5.0"} - "js_of_ocaml-tyxml" {>= "5.5.0"} + "js_of_ocaml-ppx" {>= "6.0.0"} + "js_of_ocaml-ppx_deriving_json" {>= "6.0.0"} + "js_of_ocaml-tyxml" {>= "6.0.0"} "lwt_log" "lwt_ppx" {>= "1.2.3"} "tyxml" {>= "4.6.0" & < "4.7.0"} diff --git a/src/lib/client/eliommod_dom.ml b/src/lib/client/eliommod_dom.ml index 22c4b67cb1..5b387a38df 100644 --- a/src/lib/client/eliommod_dom.ml +++ b/src/lib/client/eliommod_dom.ml @@ -686,18 +686,18 @@ let preload_css (doc : Dom_html.element Js.t) = [@@@warning "-39"] type position = - {html_top : int; html_left : int; body_top : int; body_left : int} + {html_top : float; html_left : float; body_top : float; body_left : float} [@@deriving json] [@@@warning "+39"] -let top_position = {html_top = 0; html_left = 0; body_top = 0; body_left = 0} +let top_position = {html_top = 0.; html_left = 0.; body_top = 0.; body_left = 0.} let createDocumentScroll () = - { html_top = Dom_html.document##.documentElement##.scrollTop - ; html_left = Dom_html.document##.documentElement##.scrollLeft - ; body_top = Dom_html.document##.body##.scrollTop - ; body_left = Dom_html.document##.body##.scrollLeft } + { html_top = Js.to_float Dom_html.document##.documentElement##.scrollTop + ; html_left = Js.to_float Dom_html.document##.documentElement##.scrollLeft + ; body_top = Js.to_float Dom_html.document##.body##.scrollTop + ; body_left = Js.to_float Dom_html.document##.body##.scrollLeft } (* With firefox, the scroll position is restored before to fire the popstate event. We maintain our own position. *) @@ -718,10 +718,10 @@ let _ = let getDocumentScroll () = !current_position let setDocumentScroll pos = - Dom_html.document##.documentElement##.scrollTop := pos.html_top; - Dom_html.document##.documentElement##.scrollLeft := pos.html_left; - Dom_html.document##.body##.scrollTop := pos.body_top; - Dom_html.document##.body##.scrollLeft := pos.body_left; + Dom_html.document##.documentElement##.scrollTop := Js.float pos.html_top; + Dom_html.document##.documentElement##.scrollLeft := Js.float pos.html_left; + Dom_html.document##.body##.scrollTop := Js.float pos.body_top; + Dom_html.document##.body##.scrollLeft := Js.float pos.body_left; current_position := pos (* UGLY HACK for Opera bug: Opera seem does not always take into diff --git a/src/lib/client/eliommod_dom.mli b/src/lib/client/eliommod_dom.mli index 5c849d137e..27400a9ad1 100644 --- a/src/lib/client/eliommod_dom.mli +++ b/src/lib/client/eliommod_dom.mli @@ -86,7 +86,7 @@ val iter_attrList : (** Window scrolling. *) type position = - {html_top : int; html_left : int; body_top : int; body_left : int} + {html_top : float; html_left : float; body_top : float; body_left : float} [@@deriving json] val top_position : position From a09f3b8364584ae81e90c1aec6f164cb7cf07932 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 13 Dec 2024 16:59:28 +0100 Subject: [PATCH 2/2] Adapt to Dom_html changes --- src/lib/client/eliommod_cookies.ml | 21 ++++++--------------- src/lib/eliom_client.client.ml | 19 ++++--------------- src/lib/eliom_content.client.mli | 2 +- src/lib/eliom_content_.client.ml | 4 ++-- 4 files changed, 13 insertions(+), 33 deletions(-) diff --git a/src/lib/client/eliommod_cookies.ml b/src/lib/client/eliommod_cookies.ml index 0e3607bddc..68a61984d1 100644 --- a/src/lib/client/eliommod_cookies.ml +++ b/src/lib/client/eliommod_cookies.ml @@ -140,15 +140,10 @@ let get_table ?(in_local_storage = false) = function if in_local_storage then let host = Js.string (host ^ "/substitutes") in - Js.Optdef.case - Dom_html.window##.localStorage + Js.Opt.case + Dom_html.window ##. localStorage ## (getItem host) (fun () -> Ocsigen_cookie_map.Map_path.empty) - (fun st -> - Js.Opt.case - st ## (getItem host) - (fun () -> Ocsigen_cookie_map.Map_path.empty) - (fun v -> - intern_cookies (of_json ~typ:json_cookies (Js.to_string v)))) + (fun v -> intern_cookies (of_json ~typ:json_cookies (Js.to_string v))) else Js.Optdef.get (Jstable.find cookie_tables (Js.string host)) @@ -162,13 +157,9 @@ let set_table ?(in_local_storage = false) host t = if in_local_storage then let host = Js.string (host ^ "/substitutes") in - Js.Optdef.case - Dom_html.window##.localStorage - (fun () -> ()) - (fun st -> - st - ## (setItem host - (Js.string (to_json ~typ:json_cookies (extern_cookies t))))) + Dom_html.window ##. localStorage + ## (setItem host + (Js.string (to_json ~typ:json_cookies (extern_cookies t)))) else Jstable.add cookie_tables (Js.string host) t let now () = diff --git a/src/lib/eliom_client.client.ml b/src/lib/eliom_client.client.ml index 518ade5c35..826f37ea61 100644 --- a/src/lib/eliom_client.client.ml +++ b/src/lib/eliom_client.client.ml @@ -817,23 +817,13 @@ let state_key {session_id; state_index} = let get_state state_id : state = Js.Opt.case - (Js.Optdef.case - Dom_html.window##.sessionStorage - (fun () -> - (* We use this only when the history API is - available. Sessionstorage seems to be available - everywhere the history API exists. *) - Lwt_log.raise_error_f ~section "sessionStorage not available") - (fun s -> s ## (getItem (state_key state_id)))) + Dom_html.window ##. sessionStorage ## (getItem (state_key state_id)) (fun () -> raise Not_found) (fun s -> of_json ~typ:[%json: state] (Js.to_string s)) let set_state i (v : state) = - Js.Optdef.case - Dom_html.window##.sessionStorage - (fun () -> ()) - (fun s -> - s ## (setItem (state_key i) (Js.string (to_json ~typ:[%json: state] v)))) + Dom_html.window ##. sessionStorage + ## (setItem (state_key i) (Js.string (to_json ~typ:[%json: state] v))) let update_state () = set_state !active_page.page_id @@ -866,8 +856,7 @@ let insert_base page = let get_global_data () = let def () = None and id = Js.string "__global_data" in - Js.Optdef.case Dom_html.window##.localStorage def @@ fun storage -> - Js.Opt.case storage ## (getItem id) def @@ fun v -> + Js.Opt.case Dom_html.window ##. localStorage ## (getItem id) def @@ fun v -> Lwt_log.ign_debug_f "Unwrap __global_data"; match Eliom_unwrap.unwrap (Url.decode (Js.to_string v)) 0 with | {Eliom_runtime.ecs_data = `Success v; _} -> diff --git a/src/lib/eliom_content.client.mli b/src/lib/eliom_content.client.mli index 51c793da5a..f06f51b624 100644 --- a/src/lib/eliom_content.client.mli +++ b/src/lib/eliom_content.client.mli @@ -758,7 +758,7 @@ module Html : sig val minHeightPx : 'a elt -> int val minWidth : 'a elt -> string val minWidthPx : 'a elt -> int - val opacity : 'a elt -> string option + val opacity : 'a elt -> string val outline : 'a elt -> string val outlineColor : 'a elt -> string val outlineOffset : 'a elt -> string diff --git a/src/lib/eliom_content_.client.ml b/src/lib/eliom_content_.client.ml index 0639265fd2..c4ef3bd671 100644 --- a/src/lib/eliom_content_.client.ml +++ b/src/lib/eliom_content_.client.ml @@ -963,7 +963,7 @@ module Html = struct let opacity elt = let elt = get_unique_elt "Css.opacity" elt in - Option.map Js.to_bytestring (Js.Optdef.to_option elt##.style##.opacity) + Js.to_bytestring elt##.style##.opacity let outline elt = let elt = get_unique_elt "Css.outline" elt in @@ -1406,7 +1406,7 @@ module Html = struct let opacity elt v = let elt = get_unique_elt "SetCss.opacity" elt in - elt##.style##.opacity := Js.def (Js.bytestring v) + elt##.style##.opacity := Js.bytestring v let outline elt v = let elt = get_unique_elt "SetCss.outline" elt in