diff --git a/ChangeLog b/ChangeLog index 0bfdfbb..681b58e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,32 @@ +2015-05-15 Stephen Leake + + add FIXMEs for remaining module issues + + * src/emacs_module.h: emacs_value type/size + + * src/module.c: several fixmes + +2015-05-14 Stephen Leake + + implement some missing module functions, add new ones + + * src/emacs_module.h: add buffer_byte_length, copy_buffer_substring + + * src/module.c: add buffer_byte_length, copy_buffer_substring + +2015-05-13 Stephen Leake + + * src/emacs_module.h: add Qt_value, Qnil_value change signal_error + to take 'const char*' instead of emacs_value for string add + intern_soft, bind_function, message, symbol_value + + * src/module.c: change declaration order to match emacs_module.h, + doc missing features, add new implement module_signal_error, + module_intern_soft, module_bind_function, module_message, + module_symbol_value + + * src/module.c: (Fmodule_load): improve error message + 2015-02-27 Paul Eggert Don't require GNU putenv diff --git a/src/emacs_module.h b/src/emacs_module.h index 072ee46..d903eae 100644 --- a/src/emacs_module.h +++ b/src/emacs_module.h @@ -27,6 +27,9 @@ /* Current environement */ typedef struct emacs_env_25 emacs_env; + +/* FIXME: size mismatch on 32 bit system with --with-wide-int. Have + Emacs pass env var to makefile to specify this type. */ typedef void* emacs_value; /* Struct passed to a module init function (emacs_module_init) */ @@ -51,6 +54,12 @@ struct emacs_env_25 { size_t size; /* + * Constants + */ + emacs_value Qt_value; + emacs_value Qnil_value; + + /* * Memory management */ @@ -73,7 +82,7 @@ struct emacs_env_25 { emacs_value *error_data_out); void (*signal_error)(emacs_env *env, - emacs_value error_symbol, + const char* msg, emacs_value error_data); /* @@ -93,6 +102,13 @@ struct emacs_env_25 { emacs_value (*intern)(emacs_env *env, const char *symbol_name); + emacs_value (*intern_soft)(emacs_env *env, + const char *symbol_name); + + void (*bind_function) (emacs_env *env, + const char *name, + emacs_value definition); + /* * Type conversion */ @@ -117,8 +133,38 @@ struct emacs_env_25 { char *buffer, size_t* length_inout); + size_t (*buffer_byte_length)(emacs_env *env, + emacs_value start, + emacs_value end); + /* Return the size in bytes of the buffer substring in the current + buffer from START to END */ + + void (*copy_buffer_substring)(emacs_env *env, + emacs_value start, + emacs_value end, + char *buffer, + size_t* length_inout); + /* Copy buffer string from current buffer, BEG to END (integers or + markers), to BUFFER. On call, LENGTH_INOUT is the size in bytes + of BUFFER; on return, it is the size in bytes of the copied + string. + + If BUFFER is too small, signals an error. Use buffer_byte_length + to ensure BUFFER is not too small. */ + emacs_value (*make_string)(emacs_env *env, const char *contents); + + /* + * miscellaneous + */ + + void (*message)(emacs_env *env, + emacs_value msg); + /* msg must be already formatted */ + + emacs_value (*symbol_value)(emacs_env *env, + emacs_value symbol); }; #endif /* EMACS_MODULE_H */ diff --git a/src/module.c b/src/module.c index a4fc13c..bfbaab6 100644 --- a/src/module.c +++ b/src/module.c @@ -20,15 +20,25 @@ #include #include "lisp.h" +#include "character.h" +#include "buffer.h" #include "emacs_module.h" #include +/* internal functions */ void syms_of_module (void); static struct emacs_runtime* module_get_runtime (void); static emacs_env* module_get_environment (struct emacs_runtime *ert); -static emacs_value module_make_fixnum (emacs_env *env, int64_t n); -static int64_t module_fixnum_to_int (emacs_env *env, emacs_value n); -static emacs_value module_intern (emacs_env *env, const char *name); + +/* emacs_module.h emacs_env_* functions; same order as there */ +/* FIXME: make_global_reference */ +/* FIXME: free_global_reference */ +/* FIXME: error_check */ +/* FIXME: clear_error */ +/* FIXME: get_error */ +static void module_signal_error (emacs_env *env, + const char* msg, + emacs_value error_data); static emacs_value module_make_function (emacs_env *env, int min_arity, int max_arity, @@ -37,9 +47,41 @@ static emacs_value module_funcall (emacs_env *env, emacs_value fun, int nargs, emacs_value args[]); +static emacs_value module_intern (emacs_env *env, + const char *name); +static emacs_value module_intern_soft (emacs_env *env, + const char *name); +static void module_bind_function (emacs_env *env, + const char *name, + emacs_value definition); +/* FIXME: type_of */ +static int64_t module_fixnum_to_int (emacs_env *env, + emacs_value n); +static emacs_value module_make_fixnum (emacs_env *env, + int64_t n); +/* FIXME: float_to_c_double */ +/* FIXME: make_float */ +/* FIXME: copy_string_contents */ +static size_t module_buffer_byte_length (emacs_env *env, + emacs_value start, + emacs_value end); + +static void module_copy_buffer_substring (emacs_env *env, + emacs_value start, + emacs_value end, + char *buffer, + size_t *length_inout); +static emacs_value module_make_string (emacs_env *env, + const char *contents); +static void module_message (emacs_env *env, + emacs_value msg); +static emacs_value module_symbol_value (emacs_env *env, + emacs_value symbol); + static struct emacs_runtime* module_get_runtime (void) { + /* FIXME: why do we need module_get_runtime, as opposed to just module_get_environment? */ struct emacs_runtime *ert = xzalloc (sizeof *ert); ert->size = sizeof *ert; @@ -50,14 +92,32 @@ static struct emacs_runtime* module_get_runtime (void) static emacs_env* module_get_environment (struct emacs_runtime *ert) { + /* FIXME: error if not on main emacs thread? */ + emacs_env *env = xzalloc (sizeof *env); - env->size = sizeof *env; - env->make_fixnum = module_make_fixnum; - env->fixnum_to_int = module_fixnum_to_int; - env->intern = module_intern; - env->make_function = module_make_function; - env->funcall = module_funcall; + env->size = sizeof *env; + env->Qt_value = (emacs_value) Qt; + env->Qnil_value = (emacs_value) Qnil; + /* FIXME: make_global_reference */ + /* FIXME: free_global_reference */ + /* FIXME: error_check */ + /* FIXME: clear_error */ + /* FIXME: get_error */ + env->signal_error = module_signal_error; + env->make_function = module_make_function; + env->funcall = module_funcall; + env->intern = module_intern; + env->intern_soft = module_intern_soft; + env->bind_function = module_bind_function; + env->fixnum_to_int = module_fixnum_to_int; + env->make_fixnum = module_make_fixnum; + /* FIXME: copy_string_contents */ + env->buffer_byte_length = module_buffer_byte_length; + env->copy_buffer_substring = module_copy_buffer_substring; + env->make_string = module_make_string; + env->message = module_message; + env->symbol_value = module_symbol_value; return env; } @@ -77,6 +137,32 @@ static emacs_value module_intern (emacs_env *env, const char *name) return (emacs_value) intern (name); } +static emacs_value module_intern_soft (emacs_env *env, const char *name) +{ + register ptrdiff_t len = strlen (name); + register Lisp_Object tem = oblookup (Vobarray, name, len, len); + + if (INTEGERP (tem)) + return (emacs_value) Qnil; + else + return (emacs_value) tem; +} + +static void module_bind_function (emacs_env *env, + const char *name, + emacs_value definition) +{ + Lisp_Object symbol = intern (name); + set_symbol_function (symbol, (Lisp_Object) definition); +} + +static void module_signal_error (emacs_env *env, + const char* msg, + emacs_value error_data) +{ + signal_error (msg, (Lisp_Object) (error_data)); +} + static emacs_value module_make_function (emacs_env *env, int min_arity, int max_arity, @@ -91,6 +177,7 @@ static emacs_value module_make_function (emacs_env *env, subrptr arglist))) */ + /* FIXME: allow for doc string and interactive */ Lisp_Object Qrest = intern ("&rest"); Lisp_Object Qarglist = intern ("arglist"); Lisp_Object Qmodule_call = intern ("module-call"); @@ -138,6 +225,100 @@ static emacs_value module_funcall (emacs_env *env, return (emacs_value) ret; } +static size_t module_buffer_byte_length (emacs_env *env, + emacs_value start, + emacs_value end) +{ + Lisp_Object start_1 = (Lisp_Object)start; + Lisp_Object end_1 = (Lisp_Object)end; + + validate_region (&start_1, &end_1); + + { + ptrdiff_t start_byte = CHAR_TO_BYTE (XINT (start_1)); + ptrdiff_t end_byte = CHAR_TO_BYTE (XINT (end_1)); + + return (size_t) end_byte - start_byte; + } +} + +static void module_copy_buffer_substring (emacs_env *env, + emacs_value start, + emacs_value end, + char *buffer, + size_t *length_inout) +{ + /* Copied from editfns.c "buffer-substring-no-properties" and make_buffer_string_both */ + Lisp_Object start_1 = (Lisp_Object)start; + Lisp_Object end_1 = (Lisp_Object)end; + + validate_region (&start_1, &end_1); + + { + ptrdiff_t start = XINT (start_1); + ptrdiff_t start_byte = CHAR_TO_BYTE (start); + ptrdiff_t end = XINT (end_1); + ptrdiff_t end_byte = CHAR_TO_BYTE (end); + ptrdiff_t beg0, end0, beg1, end1; + size_t size; + + if (end_byte - start_byte > *length_inout) + { + /* buffer too small */ + /* FIXME: could copy less than requested, but that's + complicated for multi-byte characters */ + signal_error ("module_copy_buffer_substring: buffer too small", Qnil); + } + + if (start_byte < GPT_BYTE && GPT_BYTE < end_byte) + { + /* Two regions, before and after the gap. */ + beg0 = start_byte; + end0 = GPT_BYTE; + beg1 = GPT_BYTE + GAP_SIZE - BEG_BYTE; + end1 = end_byte + GAP_SIZE - BEG_BYTE; + } + else + { + /* One region, before the gap. */ + beg0 = start_byte; + end0 = end_byte; + beg1 = -1; + end1 = -1; + } + + size = end0 - beg0; + + /* FIXME: need to decode? See external process stuff. */ + + /* BYTE_POS_ADDR handles one region after the gap */ + memcpy (buffer, BYTE_POS_ADDR (beg0), size); + if (beg1 != -1) + memcpy (buffer + size, BEG_ADDR + beg1, end1 - beg1); + } +} + +static emacs_value module_make_string (emacs_env *env, const char *contents) +{ + return (emacs_value) make_string (contents, strlen (contents)); +} + +static void module_message (emacs_env *env, + emacs_value msg) +{ + message3 ((Lisp_Object) msg); +} + +static emacs_value module_symbol_value (emacs_env *env, + emacs_value symbol) +{ + Lisp_Object val= find_symbol_value ((Lisp_Object) symbol); + if (!EQ (val, Qunbound)) + return (emacs_value) val; + + xsignal1 (Qvoid_variable, (Lisp_Object) symbol); +} + DEFUN ("module-call", Fmodule_call, Smodule_call, 3, 3, 0, doc: "Call a module function") (Lisp_Object envptr, Lisp_Object subrptr, Lisp_Object arglist) @@ -181,10 +362,13 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, lt_init_done = 1; } + /* FIXME: check for libltdl, load it if available; don't require + --with-ltdl at configure time. See image.c for example. */ + CHECK_STRING (file); handle = lt_dlopen (SDATA (file)); if (!handle) - error ("Cannot load file %s", SDATA (file)); + error ("Cannot load file %s : %s", SDATA (file), lt_dlerror()); gpl_sym = lt_dlsym (handle, "plugin_is_GPL_compatible"); if (!gpl_sym) @@ -197,6 +381,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, int r = module_init (module_get_runtime ()); + /* Errors are reported by calling env->signal_error. FIXME: so why does module_init return anything? */ return Qt; }