Adapt to js_of_ocaml 6.0

dune-project

@@ -24,13 +24,13 @@ The client-side code is compiled to JS using Ocsigen Js_of_ocaml or to Wasm usin
   ocamlfind
   ppx_deriving
   (ppxlib (>= 0.15.0))
-  (js_of_ocaml-compiler (and (>= 5.5.0) (< 6.0.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 (and (>= 4.6.0) (< 4.7.0)))

eliom.opam

@@ -22,13 +22,13 @@ depends: [
   "ocamlfind"
   "ppx_deriving"
   "ppxlib" {>= "0.15.0"}
-  "js_of_ocaml-compiler" {>= "5.5.0" & < "6.0.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"}

src/lib/client/eliommod_dom.ml

@@ -102,7 +102,7 @@ let fast_select_request_nodes root =
 
 let fast_select_nodes root =
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "fast_select_nodes"));
+  then Console.console ## (time (Js.string "fast_select_nodes"));
   let a_nodeList : Dom_html.element Dom.nodeList Js.t =
     root
     ## (querySelectorAll
@@ -135,7 +135,7 @@ let fast_select_nodes root =
           (Js.string ("." ^ Eliom_runtime.RawXML.ce_registered_attr_class)))
   in
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "fast_select_nodes"));
+  then Console.console ## (timeEnd (Js.string "fast_select_nodes"));
   ( a_nodeList
   , form_nodeList
   , process_node_nodeList
@@ -581,12 +581,12 @@ let rec rewrite_css ~max (media, href, css) =
     | None -> Lwt.return_nil
     | Some css ->
         if !Eliom_config.debug_timings
-        then Firebug.console ## (time (Js.string ("rewrite_CSS: " ^ href)));
+        then Console.console ## (time (Js.string ("rewrite_CSS: " ^ href)));
         let%lwt imports, css =
           rewrite_css_import ~max ~prefix:(basedir href) ~media css 0
         in
         if !Eliom_config.debug_timings
-        then Firebug.console ## (timeEnd (Js.string ("rewrite_CSS: " ^ href)));
+        then Console.console ## (timeEnd (Js.string ("rewrite_CSS: " ^ href)));
         Lwt.return (imports @ [media, css])
   with _ -> Lwt.return [media, Printf.sprintf "@import url(%s);" href]
 
@@ -662,7 +662,7 @@ let build_style (e, css) =
 
 let preload_css (doc : Dom_html.element Js.t) =
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "preload_css (fetch+rewrite)"));
+  then Console.console ## (time (Js.string "preload_css (fetch+rewrite)"));
   let%lwt css = Lwt_list.map_p build_style (fetch_linked_css (get_head doc)) in
   let css = List.concat css in
   List.iter
@@ -674,7 +674,7 @@ let preload_css (doc : Dom_html.element Js.t) =
          Lwt_log.ign_info ~section "Unique CSS skipped...")
     css;
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "preload_css (fetch+rewrite)"));
+  then Console.console ## (timeEnd (Js.string "preload_css (fetch+rewrite)"));
   Lwt.return_unit
 
 (** Window scrolling *)
@@ -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

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

src/lib/eliom_client.client.ml

@@ -105,7 +105,7 @@ let check_global_data global_data =
   | [] -> ()
   | l ->
       Printf.ksprintf
-        (fun s -> Firebug.console ## (error (Js.string s)))
+        (fun s -> Console.console ## (error (Js.string s)))
         "Code generating the following client values is not linked on the client:\n%s"
         (String.concat "\n"
            (List.rev_map
@@ -126,7 +126,7 @@ let check_global_data global_data =
   | [] -> ()
   | l ->
       Printf.ksprintf
-        (fun s -> Firebug.console ## (error (Js.string s)))
+        (fun s -> Console.console ## (error (Js.string s)))
         "Code containing the following injections is not linked on the client:\n%s"
         (String.concat "\n"
            (List.rev_map
@@ -260,12 +260,12 @@ let relink_request_node (node : Dom_html.element Js.t) =
 let relink_request_nodes root =
   Lwt_log.ign_debug ~section "Relink request nodes";
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "relink_request_nodes"));
+  then Console.console ## (time (Js.string "relink_request_nodes"));
   Eliommod_dom.iter_nodeList
     (Eliommod_dom.select_request_nodes root)
     relink_request_node;
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "relink_request_nodes"))
+  then Console.console ## (timeEnd (Js.string "relink_request_nodes"))
 
 (* Relinks a-elements, form-elements, and process nodes. The list of
    closure nodes is returned for application on [relink_closure_node]
@@ -407,12 +407,12 @@ let load_data_script page =
   in
   let script = data_script##.text in
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "load_data_script"));
+  then Console.console ## (time (Js.string "load_data_script"));
   ignore (Js.Unsafe.eval_string (Js.to_string script));
   Eliom_process.reset_request_template ();
   Eliom_process.reset_request_cookies ();
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "load_data_script"))
+  then Console.console ## (timeEnd (Js.string "load_data_script"))
 
 (* == Scroll the current page such that the top of element with the id
    [fragment] is aligned with the window's top. If the optional
@@ -1005,7 +1005,7 @@ let init () =
     Eliom_client_core.set_initial_load ();
     Lwt.async (fun () ->
       if !Eliom_config.debug_timings
-      then Firebug.console ## (time (Js.string "onload"));
+      then Console.console ## (time (Js.string "onload"));
       let%lwt () =
         Eliom_request_info.set_session_info
           ~uri:
@@ -1044,7 +1044,7 @@ let init () =
       Lwt_mutex.unlock Eliom_client_core.load_mutex;
       run_callbacks load_callbacks;
       if !Eliom_config.debug_timings
-      then Firebug.console ## (timeEnd (Js.string "onload"));
+      then Console.console ## (timeEnd (Js.string "onload"));
       Lwt.return_unit);
     Js._false
   in
@@ -1460,7 +1460,7 @@ let set_uri ~replace ?fragment uri =
 
 let replace_page ~do_insert_base new_page =
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "replace_page"));
+  then Console.console ## (time (Js.string "replace_page"));
   if !only_replace_body
   then
     let new_body = new_page ##. childNodes ## (item 1) in
@@ -1476,7 +1476,7 @@ let replace_page ~do_insert_base new_page =
     Dom.replaceChild Dom_html.document new_page
       Dom_html.document##.documentElement);
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "replace_page"))
+  then Console.console ## (timeEnd (Js.string "replace_page"))
 
 (* Function to be called for client side services: *)
 let set_content_local ?offset ?fragment new_page =
@@ -1485,7 +1485,7 @@ let set_content_local ?offset ?fragment new_page =
   let recover () =
     if !locked then Lwt_mutex.unlock Eliom_client_core.load_mutex;
     if !Eliom_config.debug_timings
-    then Firebug.console ## (timeEnd (Js.string "set_content_local"))
+    then Console.console ## (timeEnd (Js.string "set_content_local"))
   and really_set () =
     (* Inline CSS in the header to avoid the "flashing effect".
        Otherwise, the browser start to display the page before
@@ -1511,15 +1511,15 @@ let set_content_local ?offset ?fragment new_page =
     scroll_to_fragment ?offset fragment;
     advance_page ();
     if !Eliom_config.debug_timings
-    then Firebug.console ## (timeEnd (Js.string "set_content_local"));
+    then Console.console ## (timeEnd (Js.string "set_content_local"));
     Lwt.return_unit
   in
   let cancel () = recover (); Lwt.return_unit in
   try%lwt
     let%lwt () = Lwt_mutex.lock Eliom_client_core.load_mutex in
     Eliom_client_core.set_loading_phase ();
     if !Eliom_config.debug_timings
-    then Firebug.console ## (time (Js.string "set_content_local"));
+    then Console.console ## (time (Js.string "set_content_local"));
     run_onunload_wrapper really_set cancel
   with exn ->
     recover ();
@@ -1619,18 +1619,18 @@ let set_content ~replace ~uri ?offset ?fragment content =
         scroll_to_fragment ?offset fragment;
         advance_page ();
         if !Eliom_config.debug_timings
-        then Firebug.console ## (timeEnd (Js.string "set_content"));
+        then Console.console ## (timeEnd (Js.string "set_content"));
         Lwt.return_unit
       and recover () =
         if !locked then Lwt_mutex.unlock Eliom_client_core.load_mutex;
         if !Eliom_config.debug_timings
-        then Firebug.console ## (timeEnd (Js.string "set_content"))
+        then Console.console ## (timeEnd (Js.string "set_content"))
       in
       try%lwt
         let%lwt () = Lwt_mutex.lock Eliom_client_core.load_mutex in
         Eliom_client_core.set_loading_phase ();
         if !Eliom_config.debug_timings
-        then Firebug.console ## (time (Js.string "set_content"));
+        then Console.console ## (time (Js.string "set_content"));
         let g () = recover (); Lwt.return_unit in
         run_onunload_wrapper really_set g
       with exn ->

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

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

src/lib/eliom_lib.client.ml

@@ -97,7 +97,7 @@ let _ =
   Lwt_log.default := Lwt_log.console;
   Lwt.async_exception_hook :=
     fun exn ->
-      Firebug.console##error_3 (Js.string "Lwt.async:")
+      Console.console##error_3 (Js.string "Lwt.async:")
         (Js.string (Printexc.to_string exn))
         exn
 

src/lib/eliom_request.client.ml

@@ -221,18 +221,7 @@ let send ?with_credentials ?(expecting_process_page = false) ?cookies_info
     let headers =
       if expecting_process_page
       then
-        let content_type =
-          if Dom_html.onIE
-             && not
-                  (Js.Optdef.test
-                     (Js.Unsafe.coerce Dom_html.document)##.adoptNode)
-          then
-            (* ie < 9 does not know xhtml+xml content type, but ie 9
-               can use it and need it to use adoptNode *)
-            "application/xml"
-          else "application/xhtml+xml"
-        in
-        ("Accept", content_type)
+        ("Accept", "application/xhtml+xml")
         :: ( Eliom_common.expecting_process_page_name
            , encode_header_value ~typ:[%json: bool] true )
         :: headers

src/lib/eliom_unwrap.client.ml

@@ -85,10 +85,10 @@ external raw_unmarshal_and_unwrap :
 
 let unwrap s i =
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "unwrap"));
+  then Console.console ## (time (Js.string "unwrap"));
   let res = raw_unmarshal_and_unwrap apply_unwrapper s i in
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "unwrap"));
+  then Console.console ## (timeEnd (Js.string "unwrap"));
   res
 
 let unwrap_js s = unwrap (Js.to_bytestring s) 0