summaryrefslogtreecommitdiff
path: root/editor/link_editor.ml
blob: cd7f477ef223395462ac6d99414979ab95b7f67c (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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
open Js_of_ocaml
open Brr

module PM = Prosemirror

let link_edit
  : PM.View.editor_view Js.t -> < .. > Js.t
  = fun view ->

    let popin = El.div []
        ~at:At.([class' (Jstr.v "popin")]) in

    El.set_inline_style El.Style.display (Jstr.v "none") popin;

    let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
    let () = El.append_children parent [popin] in

    let hide
      : unit -> unit
      = fun () ->
        El.set_inline_style El.Style.display (Jstr.v "none") popin
    in

    let update
      : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
      = fun view _state_opt ->

        let state = view##.state in
        Js.Opt.case (state##.doc##nodeAt (view##.state##.selection##._to))
          (fun () -> hide ())
          (fun node ->
             (* Check if we are editing a link *)
             match PM.O.get state##.schema##.marks "link" with
             | None -> ()
             | Some link_type ->
               let is_present = link_type##isInSet node##.marks in
               Js.Opt.case
                 is_present
                 (fun () -> hide ())
                 (fun mark ->
                    (* Get the node's bounding position and display the popin *)
                    let position = state##.doc##resolve
                        (view##.state##.selection##._to) in
                    let start = position##start Js.null
                    and end' = position##_end Js.null in

                    Popin.set_position
                      ~start
                      ~end'
                      view popin;

                    (* Extract the value from the attribute *)
                    let attrs = mark##.attrs in
                    let href_opt = PM.O.get attrs "href" in
                    let href_value = Option.value
                        ~default:Jstr.empty
                        href_opt
                    in

                    (* Create the popin content *)
                    let a = El.a
                        ~at:At.[ href href_value ]
                        [ El.txt href_value ] in

                    let entry = Popin.build_field a
                        (fun new_value ->
                           (* The function is called when the user validate
                              the change in the popi. We create a new
                              transaction in the document by replacing the
                              mark with the new one. *)
                           if not (Jstr.equal new_value href_value) then (

                             (* Create a new attribute object for the mark in
                                order to keep history safe *)
                             let attrs' = PM.O.init
                                 [| "href", new_value |] in

                             Option.iter
                               (fun v -> PM.O.set attrs' "title" v)
                               (PM.O.get attrs "title");

                             let mark' = state##.schema##mark_fromType
                                 link_type
                                 (Js.some attrs') in
                             (* Create a transaction which update the
                                mark with the new value *)
                             view##dispatch
                               state
                               ##.tr
                               ##(removeMark
                                    ~from:start
                                    ~to_:end'
                                    mark)
                               ##(addMark
                                    ~from:start
                                    ~to_:end'
                                    mark')
                           );
                           true

                        ) in


                    El.set_children popin
                      [ entry.field
                      ; entry.button ];

                 ))

    and destroy () = El.remove popin in

    object%js
      val update = Js.wrap_callback update
      val destroy= Js.wrap_callback destroy
    end

let plugin
  : PM.t -> PM.State.plugin Js.t
  = fun t ->
    let state = Jv.get (Jv.Id.to_jv t) "state" in

    let params = object%js
      val view = (fun view -> link_edit view)
    end in

    Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
    |> Jv.Id.of_jv