open Brr open Brr_note module Js = Js_of_ocaml.Js let create: ?form:('a Note.signal * El.t) -> ?valid_on:(bool Note.signal) -> title:Jstr.t -> unit -> 'a option Note.event = fun ?form ?valid_on ~title () -> (* Ensure we keep a track for the signal event. This looks a bit like the old memory magment in C, as it require to destroy the logger each time the popup is removed. *) let log_opt = Option.map (fun (values, _) -> Note.S.log values (fun _ -> ())) form in let close_btn = El.span ~at:At.[class' (Jstr.v "modal-close")] [ El.txt' "×"] and submit_btn = El.input () ~at:At.[type' (Jstr.v "submit")] in begin match valid_on with | None -> () | Some s -> Elr.def_at (Jstr.v "disabled") (Note.S.map (fun value -> if (not value) then Some (Jstr.empty) else None) s) submit_btn end; let container = match form with | None -> El.div | Some _ -> El.form and body = match form with | None -> El.div [] | Some (_, content) -> content and footer = match form with | None -> El.txt Jstr.empty | Some _ -> El.div [ submit_btn ] ~at:At.[class' (Jstr.v "row")] in (* HTML Element creation *) let el = El.div ~at:At.[class' (Jstr.v "modal")] [ container ~at:At.[class' (Jstr.v "modal-content")] [ El.div ~at:At.[class' (Jstr.v "modal-header")] [ close_btn ; El.h3 [ El.txt title ]] ; El.div ~at:At.[class' (Jstr.v "modal-body")] [ body ] ; El.div ~at:At.[class' (Jstr.v "modal-footer")] [ footer ]]] in let () = El.append_children (Document.body G.document) [ el ] in (* Add the focus to the first input element inside the form *) let () = match form with | Some (_, el) when El.is_el el -> begin match (El.find_by_tag_name ~root:el (Jstr.v "input")) with | [] -> () | hd::_ -> El.set_has_focus true hd end | _ -> () in (* Event handler *) let close_event = Evr.on_el Ev.click (fun _ -> El.remove el; Option.iter Note.Logr.destroy log_opt; None) close_btn and submit_event = Evr.on_el Ev.click (fun _ -> El.remove el; Option.iter Note.Logr.destroy log_opt; Option.map (fun v -> Note.S.value (fst v)) form) submit_btn in Note.E.select [ close_event ; submit_event ]