diff options
Diffstat (limited to 'lib/elements/popup.ml')
| -rwxr-xr-x | lib/elements/popup.ml | 191 |
1 files changed, 90 insertions, 101 deletions
diff --git a/lib/elements/popup.ml b/lib/elements/popup.ml index 28c414e..7b65661 100755 --- a/lib/elements/popup.ml +++ b/lib/elements/popup.ml @@ -1,104 +1,93 @@ open Brr -open Brr_note +open Note_brr 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 ] +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 + + (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); + + 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 -> ( + match El.find_by_tag_name ~root:el (Jstr.v "input") with + | [] -> () + | hd :: _ -> El.set_has_focus true hd) + | _ -> () + 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 ] |