jon.recoil.org
this repo has no description
1type t = {
2 view : Code_mirror.Editor.View.t;
3 messages_comp : Code_mirror.Compartment.t;
4 lines_comp : Code_mirror.Compartment.t;
5 merlin_comp : Code_mirror.Compartment.t;
6 mutable merlin_extension : unit -> Code_mirror.Extension.t list;
7 changes : Code_mirror.Compartment.t;
8 mutable previous_lines : int;
9 mutable current_doc : string;
10 mutable messages : (int * Brr.El.t list) list;
11}
12
13let find_line_ends at doc =
14 let rec go i =
15 if i >= String.length doc || doc.[i] = '\n' then i else go (i + 1)
16 in
17 go at
18
19let render_messages cm =
20 let open Code_mirror.Editor in
21 let open Code_mirror.Decoration in
22 let (State.Facet ((module F), it)) = View.decorations () in
23 let doc = cm.current_doc in
24 let ranges =
25 Array.of_list
26 @@ List.map (fun (at, msg) ->
27 range ~from:at ~to_:at
28 @@ widget ~block:true ~side:99
29 @@ Widget.make (fun () -> msg))
30 @@ List.filter (fun (at, _) -> at <= String.length doc)
31 @@ List.map (fun (at, msg) ->
32 let at = find_line_ends at doc in
33 (at, msg))
34 @@ List.concat
35 @@ List.map (fun (loc, lst) -> List.map (fun m -> (loc, m)) lst)
36 @@ List.sort (fun (a, _) (b, _) -> Int.compare a b) cm.messages
37 in
38 F.of_ it (Range_set.of' ranges)
39
40let refresh_messages ed =
41 Code_mirror.Editor.View.dispatch ed.view
42 (Code_mirror.Compartment.reconfigure ed.messages_comp
43 [ render_messages ed ])
44
45let custom_ln editor =
46 Code_mirror.Editor.View.line_numbers (fun x ->
47 string_of_int (editor.previous_lines + x))
48
49let refresh_lines ed =
50 Code_mirror.Editor.View.dispatch ed.view
51 @@ Code_mirror.Compartment.reconfigure ed.lines_comp [ custom_ln ed ]
52
53let refresh_merlin ed =
54 Code_mirror.Editor.View.dispatch ed.view
55 @@ Code_mirror.Compartment.reconfigure ed.merlin_comp (ed.merlin_extension ())
56
57let configure_merlin ed extension =
58 ed.merlin_extension <- extension;
59 refresh_merlin ed
60
61let clear x =
62 x.messages <- [];
63 refresh_lines x;
64 refresh_messages x;
65 refresh_merlin x
66
67let source_of_state s =
68 String.concat "\n" @@ Array.to_list @@ Array.map Jstr.to_string
69 @@ Code_mirror.Text.to_jstr_array
70 @@ Code_mirror.Editor.State.doc s
71
72let source t = source_of_state @@ Code_mirror.Editor.View.state t.view
73
74let prefix_length a b =
75 let rec go i =
76 if i >= String.length a || i >= String.length b || a.[i] <> b.[i] then i
77 else go (i + 1)
78 in
79 go 0
80
81let basic_setup =
82 Jv.get Jv.global "__CM__basic_setup" |> Code_mirror.Extension.of_jv
83
84let read_only_extension () =
85 let editor_state = Jv.get Jv.global "__CM__state" in
86 let ro_facet = Jv.get editor_state "readOnly" in
87 Jv.call ro_facet "of" [| Jv.of_bool true |] |> Code_mirror.Extension.of_jv
88
89let make ?(read_only = false) parent =
90 let open Code_mirror.Editor in
91 let changes = Code_mirror.Compartment.make () in
92 let messages = Code_mirror.Compartment.make () in
93 let lines = Code_mirror.Compartment.make () in
94 let merlin = Code_mirror.Compartment.make () in
95 let extensions =
96 Array.append
97 [|
98 basic_setup;
99 Code_mirror.Editor.View.line_wrapping ();
100 Code_mirror.Compartment.of' lines [];
101 Code_mirror.Compartment.of' messages [];
102 Code_mirror.Compartment.of' changes [];
103 Code_mirror.Compartment.of' merlin [];
104 |]
105 (if read_only then [| read_only_extension () |] else [||])
106 in
107 let config = State.Config.create ~doc:Jstr.empty ~extensions () in
108 let state = State.create ~config () in
109 let opts = View.opts ~state ~parent () in
110 let view = View.create ~opts () in
111 {
112 previous_lines = 0;
113 current_doc = "";
114 messages = [];
115 view;
116 messages_comp = messages;
117 lines_comp = lines;
118 merlin_comp = merlin;
119 merlin_extension = (fun () -> []);
120 changes;
121 }
122
123let set_current_doc t new_doc =
124 let at = prefix_length t.current_doc new_doc in
125 t.current_doc <- new_doc;
126 t.messages <- List.filter (fun (loc, _) -> loc < at) t.messages;
127 refresh_messages t
128
129let on_change cm fn =
130 let has_changed =
131 let open Code_mirror.Editor in
132 let (State.Facet ((module F), it)) = View.update_listener () in
133 F.of_ it (fun ev ->
134 if View.Update.doc_changed ev then
135 let new_doc = source_of_state (View.Update.state ev) in
136 if not (String.equal cm.current_doc new_doc) then (
137 set_current_doc cm new_doc;
138 fn ()))
139 in
140 Code_mirror.Editor.View.dispatch cm.view
141 @@ Code_mirror.Compartment.reconfigure cm.changes [ has_changed ]
142
143let count_lines str =
144 if str = "" then 0
145 else
146 let nb = ref 1 in
147 for i = 0 to String.length str - 1 do
148 if str.[i] = '\n' then incr nb
149 done;
150 !nb
151
152let nb_lines t = t.previous_lines + count_lines t.current_doc
153let get_previous_lines t = t.previous_lines
154
155let set_previous_lines t nb =
156 t.previous_lines <- nb;
157 refresh_lines t
158
159let set_messages t msg =
160 t.messages <- msg;
161 refresh_messages t
162
163let clear_messages t = set_messages t []
164let add_message t loc msg = set_messages t ((loc, msg) :: t.messages)
165
166let set_source t doc =
167 set_current_doc t doc;
168 Code_mirror.Editor.View.set_doc t.view (Jstr.of_string doc)