blob: d32288cf13adca1497d95e6f054bcdbc5f054d66 (
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
open Js_of_ocaml
open Brr
module PM = Prosemirror
let change_level
: PM.t -> PM.Model.resolved_pos Js.t -> int -> (int -> bool) -> PM.State.command
= fun pm res incr pred state dispatch ->
let parent = res##.parent in
let attributes = parent##.attrs in
let current_level = if Jv.is_none attributes##.level then
0
else
attributes##.level in
let t, props = match pred current_level with
| false ->
(PM.O.get state##.schema##.nodes "heading"
, (object%js
val level = current_level + incr
end :> < > Js.t ))
| true ->
( PM.O.get state##.schema##.nodes "paragraph"
, object%js end) in
match t with
| None -> Js._false
| Some t ->
PM.Commands.set_block_type pm t props state dispatch
(** Increase the title level by one when pressing # at the begining of a line *)
let handle_sharp pm state dispatch =
let res = PM.State.selection_to (state##.selection) in
match Js.Opt.to_option res##.nodeBefore with
| Some _ -> Js._false
| None -> (* Line start *)
begin match Jstr.to_string res##.parent##._type##.name with
| "heading" -> change_level pm res 1 (fun x -> x > 5) state dispatch
| "paragraph" -> change_level pm res 1 (fun _ -> false) state dispatch
| _ -> Js._false
end
let handle_backspace pm state dispatch =
let res = PM.State.selection_to (state##.selection) in
match Js.Opt.to_option res##.nodeBefore with
| Some _ -> Js._false
| None -> (* Line start *)
begin match Jstr.to_string res##.parent##._type##.name with
| "heading" -> change_level pm res (-1) (fun x -> x <= 1) state dispatch
| _ -> Js._false
end
let default_plugins pm schema =
let props = PM.Example.options schema in
props##.menuBar := Js.some Js._true;
props##.floatingMenu := Js.some Js._true;
let setup = PM.Example.example_setup pm props in
let keymaps =
PM.Keymap.keymap pm
[| "Backspace", (handle_backspace pm)
; "#", (handle_sharp pm)
|] in
(* Add the custom keymaps in the list *)
let _ = setup##unshift keymaps in
Js.some setup
let create_new_state pm mySchema content =
let module PM = Prosemirror in
let doc = PM.Model.(
DOMParser.parse
(DOMParser.from_schema pm mySchema)
(Jv.Id.of_jv content)) in
let props = PM.State.creation_prop () in
props##.doc := Js.some doc;
props##.plugins := default_plugins pm mySchema;
PM.State.create
pm
props
let storage_key = (Jstr.v "editor")
let prosemirror id content =
begin match (Jv.is_none id), (Jv.is_none content) with
| false, false ->
let module PM = Prosemirror in
let pm = PM.v () in
let specs = PM.Model.schema_spec
(PM.SchemaList.add_list_nodes
pm
((PM.SchemaBasic.schema pm)##.spec##.nodes)
(Jstr.v "paragraph block*")
(Some (Jstr.v "block")))
(Some (PM.SchemaBasic.schema pm)##.spec##.marks)
None in
let mySchema = PM.Model.schema pm specs in
(* Create the initial state *)
let storage = Brr_io.Storage.local G.window in
let opt_data = Brr_io.Storage.get_item storage storage_key in
let state = match opt_data with
| None -> create_new_state pm mySchema content
| Some contents ->
(* Try to load from the storage *)
begin match Json.decode contents with
| Error _ -> create_new_state pm mySchema content
| Ok json ->
Console.(log [Jstr.v "Loading json"]);
let history = PM.History.(history pm (history_prop ()) ) in
let _ = history in
let obj = PM.State.configuration_prop () in
obj##.plugins := default_plugins pm mySchema;
obj##.schema := Js.some mySchema;
PM.State.fromJSON pm obj json
end
in
let props = PM.View.direct_editor_props () in
props##.state := state;
let view = PM.View.editor_view
pm
(Jv.Id.of_jv id)
props in
view##setProps props;
(* Attach an event on focus out *)
let _out_event = Brr_note.Evr.on_el
(Ev.focusout)
(fun _ ->
let contents = view##.state##toJSON () in
let storage = Brr_io.Storage.local G.window in
Brr_io.Storage.set_item
storage
storage_key
(Json.encode @@ contents)
|> Console.log_if_error ~use:()
)
(Jv.Id.of_jv id) in
()
| _, _-> Console.(error [str "No element with id '%s' '%s' found"; id ; content])
end
let () =
let open Jv in
let editor = obj
[| "attach_prosemirror", (repr prosemirror)
|] in
set global "editor" editor
|
