summaryrefslogtreecommitdiff
path: root/editor/plugins/link_editor.ml
blob: 9fcfc51deabee1e35665a2603a89decd06f869a3 (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
open Brr
module Js = Js_of_ocaml.Js
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