aboutsummaryrefslogtreecommitdiff
path: root/lib/elements/popup.ml
blob: 28c414e3ecb16e34772fcc74718497cd40b4e380 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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 ]