├── .gitignore ├── .merlin ├── .ocp-indent ├── Makefile ├── README.md ├── lib ├── emacs_plugin.ml ├── emacs_plugin.mli └── emacs_stubs.c └── test └── test_plugin.ml /.gitignore: -------------------------------------------------------------------------------- 1 | *.cmo 2 | *.cmi 3 | *.cmx 4 | *.cmt 5 | *.cmti 6 | *.o 7 | *.so 8 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | B lib 2 | S lib 3 | S test 4 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | match_clause=4 2 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | ROOT = emacs/emacs-25.0.92 2 | 3 | all: emacs_stubs.o lib/emacs_plugin.cmx test 4 | 5 | test: test_plugin.so 6 | 7 | emacs_stubs.o: lib/emacs_stubs.c 8 | gcc -std=c99 -Wall -I`ocamlc -where` -I$(ROOT)/src -fPIC -c lib/emacs_stubs.c -o emacs_stubs.o 9 | 10 | lib/emacs_plugin.cmx lib/emacs_plugin.o: lib/emacs_plugin.mli lib/emacs_plugin.ml 11 | ocamlopt -verbose -bin-annot -I lib/ -c $^ 12 | 13 | test_plugin.so: emacs_stubs.o lib/emacs_plugin.cmx test/test_plugin.ml 14 | ocamlopt -verbose -runtime-variant _pic -output-obj -I lib/ -o $@ $^ 15 | 16 | .PHONY: clean 17 | clean: 18 | rm -f *.o *.so *.cm* lib/*.o lib/*.cm* test/*.o test/*.cm* 19 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | > OCaml bindings to the new loadable module API in Emacs 25 (WIP) 2 | -------------------------------------------------------------------------------- /lib/emacs_plugin.ml: -------------------------------------------------------------------------------- 1 | (* The MIT License (MIT) 2 | 3 | Copyright (c) 2016 Nicolas Ojeda Bar 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. *) 22 | 23 | type env 24 | type value 25 | 26 | external make_global_ref: env -> value -> value = "stub_make_global_ref" 27 | external free_global_ref: env -> value -> unit = "stub_free_global_ref" 28 | external make_function: env -> int -> int -> (env -> value list -> value) -> string -> value = "stub_make_function" 29 | external funcall: env -> value -> value list -> value = "stub_funcall" 30 | external intern: env -> string -> value = "stub_intern" 31 | external type_of: env -> value -> value = "stub_type_of" 32 | external is_not_nil: env -> value -> bool = "stub_is_not_nil" 33 | external eq: env -> value -> value -> bool = "stub_eq" 34 | external extract_integer: env -> value -> int = "stub_extract_integer" 35 | external make_integer: env -> int -> value = "stub_make_integer" 36 | external extract_float: env -> value -> float = "stub_extract_float" 37 | external make_float: env -> float -> value = "stub_make_float" 38 | external extract_string: env -> value -> string = "stub_extract_string" 39 | external make_string: env -> string -> value = "stub_make_string" 40 | 41 | (* val make_user: (module USER with type t = 'a) -> (value -> 'a option) * ('a -> value) *) 42 | 43 | external vec_get: env -> value -> int -> value = "stub_vec_get" 44 | external vec_set: env -> value -> int -> value -> unit = "stub_vec_set" 45 | external vec_size: env -> value -> int = "stub_vec_size" 46 | -------------------------------------------------------------------------------- /lib/emacs_plugin.mli: -------------------------------------------------------------------------------- 1 | (* The MIT License (MIT) 2 | 3 | Copyright (c) 2016 Nicolas Ojeda Bar 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. *) 22 | 23 | (** Bindings to the Emacs loadable modules API 24 | 25 | Some remarks: 26 | 27 | - To get things started you need to register a callback (using [Callback.register]) 28 | named ["emacs_init"] of type [env -> unit]. It is important for the call 29 | to [Callback.register] to appear on the module top-level. 30 | 31 | Inside the [emacs_init] function you can used the passed [env] to register 32 | the plugin's functions using [make_function]. 33 | 34 | - [env] values are transient (stack-allocated). Under no circumstances they 35 | should be saved inside the closure passed to [make_function] and re-used 36 | after it returns. 37 | 38 | - all [value] objects are garbage-collected when the function passed to 39 | [make-function] returns, except for the return value. If you want to 40 | preserve a [value] longer than that, you need to use [make_global_ref] and 41 | [free_global_ref]. *) 42 | 43 | type env 44 | type value 45 | 46 | val make_global_ref: env -> value -> value 47 | val free_global_ref: env -> value -> unit 48 | val make_function: env -> int -> int -> (env -> value list -> value) -> string -> value 49 | val funcall: env -> value -> value list -> value 50 | val intern: env -> string -> value 51 | val type_of: env -> value -> value 52 | val is_not_nil: env -> value -> bool 53 | val eq: env -> value -> value -> bool 54 | val extract_integer: env -> value -> int 55 | val make_integer: env -> int -> value 56 | val extract_float: env -> value -> float 57 | val make_float: env -> float -> value 58 | val extract_string: env -> value -> string 59 | val make_string: env -> string -> value 60 | 61 | (* val make_user: (module USER with type t = 'a) -> (value -> 'a option) * ('a -> value) *) 62 | 63 | val vec_get: env -> value -> int -> value 64 | val vec_set: env -> value -> int -> value -> unit 65 | val vec_size: env -> value -> int 66 | -------------------------------------------------------------------------------- /lib/emacs_stubs.c: -------------------------------------------------------------------------------- 1 | /* The MIT License (MIT) 2 | 3 | Copyright (c) 2016 Nicolas Ojeda Bar 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. */ 22 | 23 | #include 24 | #include 25 | #include 26 | #include 27 | #include 28 | #include 29 | 30 | #include 31 | 32 | int plugin_is_GPL_compatible; 33 | 34 | static struct custom_operations emacs_value_custom_ops = { 35 | .identifier = "emacs_value", 36 | .finalize = custom_finalize_default, 37 | .compare = custom_compare_default, 38 | .hash = custom_hash_default, 39 | .serialize = custom_serialize_default, 40 | .deserialize = custom_deserialize_default 41 | }; 42 | 43 | #define Emacs_value_val(v) (*(emacs_value *) Data_custom_val (v)) 44 | 45 | static value 46 | alloc_emacs_value (emacs_value ev) 47 | { 48 | CAMLparam0 (); 49 | CAMLlocal1 (v); 50 | v = caml_alloc_custom (&emacs_value_custom_ops, sizeof (emacs_value), 0, 1); 51 | Emacs_value_val (v) = ev; 52 | CAMLreturn (v); 53 | } 54 | 55 | static emacs_value 56 | emacs_function_callback (emacs_env *e, ptrdiff_t nargs, emacs_value args[], void *data) 57 | { 58 | CAMLparam0 (); 59 | CAMLlocal4 (argsv, tmp, vtmp, r); 60 | value env = (value) e; 61 | argsv = Val_emptylist; 62 | for (int i = nargs-1; i >= 0; i --) { 63 | tmp = caml_alloc (2, 0); 64 | vtmp = alloc_emacs_value (args[i]); 65 | Store_field (tmp, 0, vtmp); 66 | Store_field (tmp, 1, argsv); 67 | argsv = tmp; 68 | } 69 | r = caml_callback2 (*(value *) data, env, argsv); 70 | CAMLreturnT (emacs_value, Emacs_value_val (r)); 71 | } 72 | 73 | CAMLprim value 74 | stub_make_global_ref (value e, value v) 75 | { 76 | CAMLparam2 (e, v); 77 | CAMLlocal1 (ev); 78 | emacs_env *env = (emacs_env *) e; 79 | ev = alloc_emacs_value (env->make_global_ref (env, Emacs_value_val (v))); 80 | CAMLreturn (ev); 81 | } 82 | 83 | CAMLprim value 84 | stub_free_global_ref (value e, value v) 85 | { 86 | CAMLparam2 (e, v); 87 | emacs_env *env = (emacs_env *) e; 88 | env->free_global_ref (env, Emacs_value_val (v)); 89 | CAMLreturn (Val_unit); 90 | } 91 | 92 | CAMLprim value 93 | stub_make_function (value e, value min_arity, value max_arity, value f, value doc) 94 | { 95 | CAMLparam5 (e, min_arity, max_arity, f, doc); 96 | CAMLlocal1 (v); 97 | emacs_env *env = (emacs_env *) e; 98 | value *root = malloc (sizeof (value)); 99 | *root = f; 100 | caml_register_generational_global_root (root); 101 | v = alloc_emacs_value 102 | (env->make_function (env, Int_val (min_arity), Int_val (max_arity), emacs_function_callback, String_val (doc), root)); 103 | CAMLreturn (v); 104 | } 105 | 106 | CAMLprim value 107 | stub_funcall (value e, value f, value args) 108 | { 109 | CAMLparam3 (e, f, args); 110 | CAMLlocal2 (v, ml); 111 | emacs_env *env = (emacs_env *) e; 112 | int nargs = 0; 113 | ml = args; 114 | while (ml != Val_emptylist) { 115 | nargs ++; 116 | ml = Field (ml, 1); 117 | } 118 | emacs_value *eargs = calloc (nargs, sizeof (emacs_value)); 119 | ml = args; 120 | for (int i = 0; i < nargs; i ++) { 121 | eargs[i] = Emacs_value_val (Field (ml, 0)); 122 | ml = Field (ml, 1); 123 | } 124 | emacs_value ev = env->funcall (env, Emacs_value_val (f), nargs, eargs); 125 | free (eargs); 126 | v = alloc_emacs_value (ev); 127 | CAMLreturn (v); 128 | } 129 | 130 | CAMLprim value 131 | stub_intern (value e, value s) 132 | { 133 | CAMLparam2 (e, s); 134 | CAMLlocal1 (v); 135 | emacs_env *env = (emacs_env *) e; 136 | v = alloc_emacs_value (env->intern (env, String_val (s))); 137 | CAMLreturn (v); 138 | } 139 | 140 | CAMLprim value 141 | stub_type_of (value e, value v) 142 | { 143 | CAMLparam2 (e, v); 144 | CAMLlocal1 (r); 145 | emacs_env *env = (emacs_env *) e; 146 | r = alloc_emacs_value (env->type_of (env, Emacs_value_val (v))); 147 | CAMLreturn (r); 148 | } 149 | 150 | CAMLprim value 151 | stub_is_not_nil (value e, value v) 152 | { 153 | CAMLparam2 (e, v); 154 | emacs_env *env = (emacs_env *) e; 155 | CAMLreturn (Val_bool (env->type_of (env, Emacs_value_val (v)))); 156 | } 157 | 158 | CAMLprim value 159 | stub_eq (value e, value v1, value v2) 160 | { 161 | CAMLparam3 (e, v1, v2); 162 | emacs_env *env = (emacs_env *) e; 163 | CAMLreturn (Val_bool (env->eq (env, Emacs_value_val (v1), Emacs_value_val (v2)))); 164 | } 165 | 166 | CAMLprim value 167 | stub_extract_integer (value e, value v) 168 | { 169 | CAMLparam2 (e, v); 170 | emacs_env *env = (emacs_env *) e; 171 | CAMLreturn (Val_int (env->extract_integer (env, Emacs_value_val (v)))); 172 | } 173 | 174 | CAMLprim value 175 | stub_make_integer (value e, value v) 176 | { 177 | CAMLparam2 (e, v); 178 | CAMLlocal1 (ev); 179 | emacs_env *env = (emacs_env *) e; 180 | ev = alloc_emacs_value (env->make_integer (env, Int_val (v))); 181 | CAMLreturn (ev); 182 | } 183 | 184 | CAMLprim value 185 | stub_extract_float (value e, value v) 186 | { 187 | CAMLparam2 (e, v); 188 | CAMLlocal1 (d); 189 | emacs_env *env = (emacs_env *) e; 190 | d = caml_copy_double (env->extract_float (env, Emacs_value_val (v))); 191 | CAMLreturn (d); 192 | } 193 | 194 | 195 | CAMLprim value 196 | stub_make_float (value e, value v) 197 | { 198 | CAMLparam2 (e, v); 199 | CAMLlocal1 (ev); 200 | emacs_env *env = (emacs_env *) e; 201 | ev = alloc_emacs_value (env->make_float (env, Double_val (v))); 202 | CAMLreturn (ev); 203 | } 204 | 205 | CAMLprim value 206 | stub_extract_string (value e, value v) 207 | { 208 | CAMLparam2 (e, v); 209 | CAMLlocal1 (res); 210 | emacs_env *env = (emacs_env *) e; 211 | long len = 0; 212 | env->copy_string_contents (env, Emacs_value_val (v), NULL, &len); 213 | res = caml_alloc_string (len-1); 214 | env->copy_string_contents (env, Emacs_value_val (v), String_val(res), &len); 215 | CAMLreturn (res); 216 | } 217 | 218 | CAMLprim value 219 | stub_make_string (value e, value s) 220 | { 221 | CAMLparam2 (e, s); 222 | CAMLlocal1 (ev); 223 | emacs_env *env = (emacs_env *) e; 224 | ev = alloc_emacs_value (env->make_string (env, String_val (s), caml_string_length (s))); 225 | CAMLreturn (ev); 226 | } 227 | 228 | CAMLprim value 229 | stub_vec_get (value e, value v, value i) 230 | { 231 | CAMLparam3 (e, v, i); 232 | CAMLlocal1 (ev); 233 | emacs_env *env = (emacs_env *) e; 234 | ev = alloc_emacs_value (env->vec_get (env, Emacs_value_val (v), Int_val (i))); 235 | CAMLreturn (ev); 236 | } 237 | 238 | CAMLprim value 239 | stub_vec_set (value e, value v, value i, value x) 240 | { 241 | CAMLparam4 (e, v, i, x); 242 | emacs_env *env = (emacs_env *) e; 243 | env->vec_set (env, Emacs_value_val (v), Int_val (i), Emacs_value_val (x)); 244 | CAMLreturn (Val_unit); 245 | } 246 | 247 | CAMLprim value 248 | stub_vec_size (value e, value v) 249 | { 250 | CAMLparam2 (e, v); 251 | emacs_env *env = (emacs_env *) e; 252 | int sz = env->vec_size (env, Emacs_value_val (v)); 253 | CAMLreturn (Val_int (sz)); 254 | } 255 | 256 | int 257 | emacs_module_init (struct emacs_runtime *ert) 258 | { 259 | char *argv[] = { "", NULL }; 260 | caml_main (argv); 261 | callback (*caml_named_value ("emacs_init"), (value) ert->get_environment (ert)); 262 | return 0; 263 | } 264 | -------------------------------------------------------------------------------- /test/test_plugin.ml: -------------------------------------------------------------------------------- 1 | open Emacs_plugin 2 | 3 | let bind_function env name f = 4 | let qfset = intern env "fset" in 5 | let qsym = intern env name in 6 | ignore (funcall env qfset [qsym; f]) 7 | 8 | let provide env feature = 9 | let qfeat = intern env feature in 10 | let qprovide = intern env "provide" in 11 | ignore (funcall env qprovide [qfeat]) 12 | 13 | let emacs_init env = 14 | bind_function env "anyone-there" (make_function env 0 0 (fun env _ -> intern env "hello") "foodoc"); 15 | provide env "test_plugin" 16 | 17 | let () = 18 | prerr_endline "test_plugin"; 19 | Callback.register "emacs_init" emacs_init 20 | --------------------------------------------------------------------------------