this repo has no description
Replace Compartment with StateField for message decorations
The Compartment+reconfigure approach caused "Position out of range for
changeset" RangeErrors because decorations weren't mapped through
document change transactions. A StateField maps decorations via
RangeSet.map(tr.changes) synchronously within each transaction,
keeping positions consistent with the document state.
- Add StateEffect and StateField OCaml bindings to jsoo-code-mirror
- Add Decoration.Range_set.empty and .map
- Convert editor.ml messages from Compartment to StateField+StateEffect
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+36
-20
+36
-20
src/editor.ml
+36
-20
src/editor.ml
···
1
1
type t = {
2
2
view : Code_mirror.Editor.View.t;
3
-
messages_comp : Code_mirror.Compartment.t;
4
3
lines_comp : Code_mirror.Compartment.t;
5
4
merlin_comp : Code_mirror.Compartment.t;
6
5
mutable merlin_extension : unit -> Code_mirror.Extension.t list;
···
16
15
in
17
16
go at
18
17
19
-
let render_messages cm =
20
-
let open Code_mirror.Editor in
18
+
let set_messages_effect = Code_mirror.State_effect.define ()
19
+
20
+
let messages_field =
21
+
Code_mirror.State_field.define
22
+
~create:(fun () ->
23
+
Code_mirror.Decoration.Range_set.(to_jv empty))
24
+
~update:(fun decos tr ->
25
+
let open Code_mirror.Decoration in
26
+
let decos = Range_set.map (Range_set.of_jv decos) (Jv.get tr "changes") in
27
+
let effects = Jv.to_jv_array (Jv.get tr "effects") in
28
+
Range_set.to_jv
29
+
(Array.fold_left
30
+
(fun acc e ->
31
+
if Code_mirror.State_effect.is e set_messages_effect then
32
+
Range_set.of_jv (Code_mirror.State_effect.value e)
33
+
else acc)
34
+
decos effects))
35
+
~provide:(fun field ->
36
+
let deco_facet =
37
+
Jv.get (Jv.get Jv.global "__CM__view") "decorations"
38
+
in
39
+
Jv.call deco_facet "from" [| field |] |> Code_mirror.Extension.of_jv)
40
+
41
+
let build_range_set cm =
21
42
let open Code_mirror.Decoration in
22
-
let (State.Facet ((module F), it)) = View.decorations () in
23
43
let doc = cm.current_doc in
24
44
let ranges =
25
45
Array.of_list
···
31
51
@@ List.map (fun (at, msg) ->
32
52
let at = min at (String.length doc) in
33
53
let at = find_line_ends at doc in
34
-
(* Clamp to last character — decorations at doc.length can cause
35
-
RangeError when CodeMirror maps them through changesets *)
36
54
let at = min at (max 0 (String.length doc - 1)) in
37
55
(at, msg))
38
56
@@ List.concat
39
57
@@ List.map (fun (loc, lst) -> List.map (fun m -> (loc, m)) lst)
40
58
@@ List.sort (fun (a, _) (b, _) -> Int.compare a b) cm.messages
41
59
in
42
-
try F.of_ it (Range_set.of' ranges)
43
-
with _ -> F.of_ it (Range_set.of' [||])
60
+
try Range_set.of' ranges with _ -> Range_set.of' [||]
44
61
45
62
let refresh_messages ed =
46
-
try
47
-
Code_mirror.Editor.View.dispatch ed.view
48
-
(Code_mirror.Compartment.reconfigure ed.messages_comp
49
-
[ render_messages ed ])
50
-
with _ -> ()
51
-
(* RangeError can occur when CodeMirror maps decoration positions
52
-
through changesets if the cached doc length differs from the
53
-
actual CodeMirror document length. Swallow to prevent cascade
54
-
failures in the cell execution chain. *)
63
+
let range_set = build_range_set ed in
64
+
let effect =
65
+
Code_mirror.State_effect.of_ set_messages_effect
66
+
(Code_mirror.Decoration.Range_set.to_jv range_set)
67
+
in
68
+
let txn =
69
+
Jv.obj [| ("effects", effect) |]
70
+
|> Code_mirror.Editor.View.Transaction.of_jv
71
+
in
72
+
try Code_mirror.Editor.View.dispatch ed.view txn with _ -> ()
55
73
56
74
let custom_ln editor =
57
75
Code_mirror.Editor.View.line_numbers (fun x ->
···
100
118
let make ?(read_only = false) parent =
101
119
let open Code_mirror.Editor in
102
120
let changes = Code_mirror.Compartment.make () in
103
-
let messages = Code_mirror.Compartment.make () in
104
121
let lines = Code_mirror.Compartment.make () in
105
122
let merlin = Code_mirror.Compartment.make () in
106
123
let extensions =
···
109
126
basic_setup;
110
127
Code_mirror.Editor.View.line_wrapping ();
111
128
Code_mirror.Compartment.of' lines [];
112
-
Code_mirror.Compartment.of' messages [];
129
+
messages_field;
113
130
Code_mirror.Compartment.of' changes [];
114
131
Code_mirror.Compartment.of' merlin [];
115
132
|]
···
124
141
current_doc = "";
125
142
messages = [];
126
143
view;
127
-
messages_comp = messages;
128
144
lines_comp = lines;
129
145
merlin_comp = merlin;
130
146
merlin_extension = (fun () -> []);