Lib: fix onbeforeunload handler breaking navigation (#1436)

CHANGES.md

@@ -85,6 +85,7 @@
 * Runtime/wasm: fix unmarshalling of compressed data (#2141)
 * Runtime: fix compilation of loops at start of exception handlers (#2151)
 * Compiler: fix parallel renaming (#2156)
+* Lib: fix `onbeforeunload` handler breaking navigation (#1436)
 
 # 6.2.0 (2025-07-30) - Lille
 

lib/js_of_ocaml/dom.ml

@@ -437,26 +437,60 @@ class type ['a, 'b] customEvent = object
   method detail : 'b Js.opt Js.readonly_prop
 end
 
+class type beforeUnloadEvent = object
+  inherit [element] event
+
+  method returnValue : js_string t prop
+end
+
 let no_handler : ('a, 'b) event_listener = Js.null
 
 (* The function preventDefault must be called explicitly when
    using addEventListener... *)
+
+(* The [beforeunload] event has special return-value semantics: all modern
+   browsers show a confirmation dialog when the handler returns any value
+   other than [null] or [undefined].  When the handler returns [true] (allow
+   the event), we must return [undefined] to the browser instead of [true]
+   so that it does not trigger the dialog.  When the handler returns [false]
+   (block the event), we also set [returnValue] for legacy browser compat. *)
+let beforeunload_return (e : _ #event t) (res : bool t) : bool t =
+  let is_beforeunload_event : _ #event t -> bool t =
+   fun e ->
+    Js.Unsafe.fun_call
+      (Js.Unsafe.pure_js_expr
+         {| (function (e) { return ("type" in e && e.type === "beforeunload") }) |})
+      [| Js.Unsafe.coerce e |]
+  in
+  if Js.to_bool (is_beforeunload_event e)
+  then
+    if Js.to_bool res
+    then (Obj.magic Js.undefined : bool t)
+    else begin
+      (Js.Unsafe.coerce e : beforeUnloadEvent t)##.returnValue := Js.string "";
+      res
+    end
+  else res
+
 let handler f =
   Js.some
     (Js.Unsafe.callback (fun e ->
          let res = f e in
          if not (Js.to_bool res) then e##preventDefault;
-         res))
+         beforeunload_return e res))
 
 let full_handler f =
   Js.some
     (Js.Unsafe.meth_callback (fun this e ->
          let res = f this e in
          if not (Js.to_bool res) then e##preventDefault;
-         res))
+         beforeunload_return e res))
 
 let invoke_handler (f : ('a, 'b) event_listener) (this : 'a) (event : 'b) : bool t =
-  Js.Unsafe.call f this [| Js.Unsafe.inject event |]
+  let res = Js.Unsafe.call f this [| Js.Unsafe.inject event |] in
+  (* Normalize: beforeunload handlers return [undefined] for "allow navigation".
+     [undefined] is not a valid [bool t], so convert it back to [true]. *)
+  if Js.Optdef.test (Obj.magic res : bool t Js.optdef) then res else Js._true
 
 let eventTarget (e : (< .. > as 'a) #event t) : 'a t =
   Opt.get e##.target (fun () -> Opt.get e##.srcElement (fun () -> raise Not_found))

lib/js_of_ocaml/dom.mli

@@ -456,6 +456,12 @@ class type ['a, 'b] customEvent = object
   method detail : 'b Js.opt Js.readonly_prop
 end
 
+class type beforeUnloadEvent = object
+  inherit [element] event
+
+  method returnValue : js_string t prop
+end
+
 (** {2 Event handlers} *)
 
 val no_handler : ('a, 'b) event_listener

lib/js_of_ocaml/dom_html.ml

@@ -896,6 +896,12 @@ and eventTarget = object ('self)
   method dispatchEvent : event t -> bool t meth
 end
 
+and beforeUnloadEvent = object
+  inherit event
+
+  method returnValue : js_string t prop
+end
+
 and popStateEvent = object
   inherit event
 
@@ -1527,6 +1533,8 @@ module Event = struct
 
   let unload = Dom.Event.make "unload"
 
+  (** The event type is [beforeUnloadEvent], which exposes the [returnValue]
+      property needed to trigger the browser's "leave page?" confirmation dialog. *)
   let beforeunload = Dom.Event.make "beforeunload"
 
   let resize = Dom.Event.make "resize"
@@ -3585,7 +3593,7 @@ class type window = object
 
   method onunload : (window t, event t) event_listener prop
 
-  method onbeforeunload : (window t, event t) event_listener prop
+  method onbeforeunload : (window t, beforeUnloadEvent t) event_listener prop
 
   method onblur : (window t, focusEvent t) event_listener prop
 

lib/js_of_ocaml/dom_html.mli

@@ -913,6 +913,12 @@ and eventTarget = object ('self)
   method dispatchEvent : event t -> bool t meth
 end
 
+and beforeUnloadEvent = object
+  inherit event
+
+  method returnValue : js_string t prop
+end
+
 and popStateEvent = object
   inherit event
 
@@ -3458,7 +3464,7 @@ class type window = object
 
   method onunload : (window t, event t) event_listener prop
 
-  method onbeforeunload : (window t, event t) event_listener prop
+  method onbeforeunload : (window t, beforeUnloadEvent t) event_listener prop
 
   method onblur : (window t, focusEvent t) event_listener prop
 
@@ -3660,7 +3666,7 @@ module Event : sig
 
   val unload : event t typ
 
-  val beforeunload : event t typ
+  val beforeunload : beforeUnloadEvent t typ
 
   val resize : event t typ
 

lib/lwt/lwt_js_events.mli

@@ -1166,7 +1166,7 @@ val domContentLoaded : unit -> unit Lwt.t
 
 val onunload : unit -> Dom_html.event Js.t Lwt.t
 
-val onbeforeunload : unit -> Dom_html.event Js.t Lwt.t
+val onbeforeunload : unit -> Dom_html.beforeUnloadEvent Js.t Lwt.t
 
 val onresize : unit -> Dom_html.event Js.t Lwt.t
 

lib/tests-browser/test_beforeunload.ml

@@ -17,7 +17,7 @@ let clear_log () =
 let set_strategy_1 () =
   clear_log ();
   Dom_html.window##.onbeforeunload
-  := Dom_html.handler (fun (_e : Dom_html.event Js.t) ->
+  := Dom_html.handler (fun (_e : Dom_html.beforeUnloadEvent Js.t) ->
       log "handler called, returning Js._false (block)";
       Js._false);
   log "Strategy 1: handler returning Js._false (block)";
@@ -30,7 +30,7 @@ let set_strategy_1 () =
 let set_strategy_2 () =
   clear_log ();
   Dom_html.window##.onbeforeunload
-  := Dom_html.handler (fun (_e : Dom_html.event Js.t) ->
+  := Dom_html.handler (fun (_e : Dom_html.beforeUnloadEvent Js.t) ->
       log "handler called, returning Js._true (allow)";
       Js._true);
   log "Strategy 2: handler returning Js._true (allow)";
@@ -44,7 +44,7 @@ let should_block = ref true
 let set_strategy_3 () =
   clear_log ();
   Dom_html.window##.onbeforeunload
-  := Dom_html.handler (fun (_e : Dom_html.event Js.t) ->
+  := Dom_html.handler (fun (_e : Dom_html.beforeUnloadEvent Js.t) ->
       log (Printf.sprintf "handler called, should_block=%b" !should_block);
       Js.bool (not !should_block));
   log "Strategy 3: handler with conditional logic";