anil.recoil.org
1// OCaml declarations
2#include <caml/alloc.h>
3#include <caml/memory.h>
4#include <caml/callback.h>
5#include <caml/fail.h>
6#include <caml/threads.h>
7
8#include <errno.h>
9#include <assert.h>
10
11#include "linenoise_src.h"
12
13// Ripped from ctypes
14#define Val_none Val_int(0)
15#define Some_val(v) Field(v, 0)
16
17static value Val_some(value v)
18{
19 CAMLparam1(v);
20 CAMLlocal1(some);
21 some = caml_alloc(1, 0);
22 Store_field(some, 0, v);
23 CAMLreturn(some);
24}
25
26/* if true, raise Sys.Break on ctrl-c */
27static int raise_sys_break = 0;
28
29CAMLprim value ml_catch_break(value flag)
30{
31 CAMLparam1(flag);
32 raise_sys_break = Bool_val(flag);
33 CAMLreturn(Val_unit);
34}
35
36CAMLprim value ml_add_completion(value completions, value new_completion)
37{
38 CAMLparam2(completions, new_completion);
39 char* c_new_completion = caml_stat_strdup(String_val(new_completion));
40 linenoiseAddCompletion((linenoiseCompletions *)completions, c_new_completion);
41 caml_stat_free(c_new_completion);
42 CAMLreturn(Val_unit);
43}
44
45// this bridge runs with the runtime lock acquired
46static void completion_bridge_inner(const char *buf, linenoiseCompletions *lc)
47{
48 CAMLparam0();
49 CAMLlocal1(str_copy);
50 str_copy = caml_copy_string(buf);
51 caml_callback2(*caml_named_value("lnoise_completion_cb"), str_copy, (value)lc);
52 CAMLreturn0;
53}
54
55static void completion_bridge(const char *buf, linenoiseCompletions *lc)
56{
57 caml_acquire_runtime_system();
58 completion_bridge_inner(buf, lc);
59 caml_release_runtime_system();
60}
61
62static char *hints_bridge_inner(const char *buf, int *color, int *bold)
63{
64 CAMLparam0();
65 CAMLlocal2(str_copy, cb_result);
66
67 str_copy = caml_copy_string(buf);
68
69 cb_result = caml_callback(*caml_named_value("lnoise_hints_cb"), str_copy);
70 if (cb_result == Val_none) {
71 CAMLreturnT(char *,NULL);
72 } else {
73 char* msg = caml_stat_strdup(String_val(Field(Field(cb_result, 0), 0)));
74 *color = Int_val(Field(Field(cb_result, 0), 1)) + 31;
75 *bold = Bool_val(Field(Field(cb_result, 0), 2));
76 CAMLreturnT(char *,msg);
77 }
78}
79
80static char *hints_bridge(const char *buf, int *color, int *bold)
81{
82 caml_acquire_runtime_system();
83 char* res = hints_bridge_inner(buf, color, bold);
84 caml_release_runtime_system();
85 return res;
86}
87
88
89static void free_hints_bridge(void* data) {
90 caml_acquire_runtime_system();
91 caml_stat_free(data);
92 caml_release_runtime_system();
93}
94
95__attribute__((constructor))
96void set_free_hints(void) { linenoiseSetFreeHintsCallback(free); }
97
98CAMLprim value ml_setup_bridges(value unit) {
99 CAMLparam1(unit);
100 linenoiseSetCompletionCallback(completion_bridge);
101 linenoiseSetHintsCallback(hints_bridge);
102 linenoiseSetFreeHintsCallback(free_hints_bridge);
103 CAMLreturn(Val_unit);
104}
105
106CAMLprim value ml_linenoise(value prompt)
107{
108 CAMLparam1(prompt);
109 CAMLlocal1(lnoise_result);
110
111 linenoiseWasInterrupted = 0; // reset
112 char* c_prompt = caml_stat_strdup(String_val(prompt));
113
114 caml_release_runtime_system();
115 const char *result = linenoise(c_prompt);
116 caml_acquire_runtime_system();
117
118 caml_stat_free(c_prompt);
119 if (!result) {
120 if (linenoiseWasInterrupted && raise_sys_break) {
121 caml_raise_constant(*caml_named_value("sys_break"));
122 } else {
123 CAMLreturn(Val_none);
124 }
125 }
126 lnoise_result = caml_copy_string(result);
127 linenoiseFree((void*)result);
128 CAMLreturn(Val_some(lnoise_result));
129}
130
131CAMLprim value ml_history_add(value line)
132{
133 CAMLparam1(line);
134 char* c_line = caml_stat_strdup(String_val(line));
135 int res = linenoiseHistoryAdd(c_line);
136 caml_stat_free(c_line);
137 CAMLreturn(Val_int(res));
138}
139
140CAMLprim value ml_history_set_maxlen(value max)
141{
142 CAMLparam1(max);
143 CAMLreturn(Val_int(linenoiseHistorySetMaxLen(Int_val(max))));
144}
145
146CAMLprim value ml_history_save(value filename)
147{
148 CAMLparam1(filename);
149 char* c_filename = caml_stat_strdup(String_val(filename));
150 int res = linenoiseHistorySave(c_filename);
151 caml_stat_free(c_filename);
152 CAMLreturn(Val_int(res));
153}
154
155CAMLprim value ml_history_load(value filename)
156{
157 CAMLparam1(filename);
158 char* c_filename= caml_stat_strdup(String_val(filename));
159 int res = linenoiseHistoryLoad(c_filename);
160 caml_stat_free(c_filename);
161 CAMLreturn(Val_int(res));
162}
163
164CAMLprim value ml_clearscreen(__attribute__((unused))value unit)
165{
166 CAMLparam0();
167 linenoiseClearScreen();
168 CAMLreturn(Val_unit);
169}
170
171CAMLprim value ml_set_multiline(value use_multiline)
172{
173 CAMLparam1(use_multiline);
174 linenoiseSetMultiLine(Bool_val(use_multiline));
175 CAMLreturn(Val_unit);
176}
177
178CAMLprim value ml_printkeycodes(void)
179{
180 CAMLparam0();
181 linenoisePrintKeyCodes();
182 CAMLreturn(Val_unit);
183}