blob: 64fb7235726744357f1c537909670229f579a6c2 (
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
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
|
open Js_of_ocaml
open Brr
module PM = Prosemirror
let change_level
: PM.t -> PM.Model.resolved_pos Js.t -> PM.State.editor_state Js.t -> int -> (PM.State.transaction Js.t -> unit) -> (int -> bool) -> bool
= fun pm res state incr dispatch pred ->
let parent = res##.parent in
let attributes = parent##.attrs in
(* There are some problems to update the view when the content is empty.
It looks like the comparaison does not comprae the level argument.
In order to prevent any error, juste return in such situation.
*)
let empty_content = parent##.content##eq (PM.Model.empty_fragment pm)
and level = attributes##.level in
if (pred level || empty_content) then false
else
(* Look the position for the previous element *)
let resolved = (res##.doc)##resolve (res##.pos -1) in
let selection = PM.State.node_selection pm resolved in
let props = object%js
val level = level + incr
end in
let element = parent##copy (PM.Model.empty_fragment pm) in
element##.attrs := props;
element##.content := parent##.content;
(* Create a new transaction for replacing the selection *)
let tr = state##.tr in
let tr = tr##replaceRangeWith
selection##.from
selection##._to
element in
(* Return at the initial position *)
let position = PM.State.create_text_selection
pm
tr##.doc
res##.pos in
let tr = tr##setSelection position in
dispatch (tr##scrollIntoView ());
true
let handle_backspace pm state dispatch =
(* Get the currrent node *)
let res = PM.State.selection_to (state##.selection) in
match Js.Opt.to_option res##.nodeBefore with
| Some _ -> false
| None -> (* Line start *)
let parent = res##.parent in
begin match Jstr.to_string parent##._type##.name with
| "heading" -> change_level pm res state (-1) dispatch (fun x -> x <= 1)
| _ -> false
end
(** Increase the title level by one when pressing # at the begining of a line *)
let handle_sharp pm state dispatch =
(* Get the currrent node *)
let res = PM.State.selection_to (state##.selection) in
match Js.Opt.to_option res##.nodeBefore with
| Some _ -> false
| None -> (* Line start *)
let parent = res##.parent in
begin match Jstr.to_string parent##._type##.name with
| "heading" -> change_level pm res state (+1) dispatch (fun x -> x > 5)
| _ -> false
end
let default_plugins pm schema =
let props = PM.Example.options schema in
props##.menuBar := Js.some false;
props##.floatingMenu := Js.some false;
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
|
