Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1 | /* vi:set ts=8 sts=4 sw=4: |
| 2 | * |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 3 | * MzScheme interface by Sergey Khorev <sergey.khorev@gmail.com> |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 4 | * Original work by Brent Fulgham <bfulgham@debian.org> |
| 5 | * (Based on lots of help from Matthew Flatt) |
| 6 | * |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 7 | * TODO Convert byte-strings to char strings? |
| 8 | * |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 9 | * This consists of six parts: |
| 10 | * 1. MzScheme interpreter main program |
| 11 | * 2. Routines that handle the external interface between MzScheme and |
| 12 | * Vim. |
| 13 | * 3. MzScheme input/output handlers: writes output via [e]msg(). |
| 14 | * 4. Implementation of the Vim Features for MzScheme |
| 15 | * 5. Vim Window-related Manipulation Functions. |
| 16 | * 6. Vim Buffer-related Manipulation Functions |
| 17 | * |
| 18 | * NOTES |
| 19 | * 1. Memory, allocated with scheme_malloc*, need not to be freed explicitly, |
| 20 | * garbage collector will do it self |
| 21 | * 2. Requires at least NORMAL features. I can't imagine why one may want |
| 22 | * to build with SMALL or TINY features but with MzScheme interface. |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 23 | * 3. I don't use K&R-style functions. Anyways, MzScheme headers are ANSI. |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 24 | */ |
| 25 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 26 | #include "vim.h" |
Bram Moolenaar | 049377e | 2007-05-12 15:32:12 +0000 | [diff] [blame] | 27 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 28 | #include "if_mzsch.h" |
| 29 | |
Bram Moolenaar | 76b92b2 | 2006-03-24 22:46:53 +0000 | [diff] [blame] | 30 | /* Only do the following when the feature is enabled. Needed for "make |
| 31 | * depend". */ |
| 32 | #if defined(FEAT_MZSCHEME) || defined(PROTO) |
| 33 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 34 | /* Base data structures */ |
| 35 | #define SCHEME_VIMBUFFERP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type) |
| 36 | #define SCHEME_VIMWINDOWP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_window_type) |
| 37 | |
| 38 | typedef struct |
| 39 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 40 | Scheme_Object so; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 41 | buf_T *buf; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 42 | } vim_mz_buffer; |
| 43 | |
| 44 | #define INVALID_BUFFER_VALUE ((buf_T *)(-1)) |
| 45 | |
| 46 | typedef struct |
| 47 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 48 | Scheme_Object so; |
Bram Moolenaar | 1d2ba7f | 2006-02-14 22:29:30 +0000 | [diff] [blame] | 49 | win_T *win; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 50 | } vim_mz_window; |
| 51 | |
| 52 | #define INVALID_WINDOW_VALUE ((win_T *)(-1)) |
| 53 | |
| 54 | /* |
| 55 | * Prims that form MzScheme Vim interface |
| 56 | */ |
| 57 | typedef struct |
| 58 | { |
| 59 | Scheme_Closed_Prim *prim; |
| 60 | char *name; |
| 61 | int mina; /* arity information */ |
| 62 | int maxa; |
| 63 | } Vim_Prim; |
| 64 | |
| 65 | typedef struct |
| 66 | { |
| 67 | char *name; |
| 68 | Scheme_Object *port; |
| 69 | } Port_Info; |
| 70 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 71 | /* |
| 72 | *======================================================================== |
| 73 | * Vim-Control Commands |
| 74 | *======================================================================== |
| 75 | */ |
| 76 | /* |
| 77 | *======================================================================== |
| 78 | * Utility functions for the vim/mzscheme interface |
| 79 | *======================================================================== |
| 80 | */ |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 81 | #ifdef HAVE_SANDBOX |
| 82 | static Scheme_Object *sandbox_file_guard(int, Scheme_Object **); |
| 83 | static Scheme_Object *sandbox_network_guard(int, Scheme_Object **); |
Bram Moolenaar | c81e5e7 | 2007-05-05 18:24:42 +0000 | [diff] [blame] | 84 | static void sandbox_check(void); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 85 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 86 | /* Buffer-related commands */ |
| 87 | static Scheme_Object *buffer_new(buf_T *buf); |
| 88 | static Scheme_Object *get_buffer_by_name(void *, int, Scheme_Object **); |
| 89 | static Scheme_Object *get_buffer_by_num(void *, int, Scheme_Object **); |
| 90 | static Scheme_Object *get_buffer_count(void *, int, Scheme_Object **); |
| 91 | static Scheme_Object *get_buffer_line(void *, int, Scheme_Object **); |
| 92 | static Scheme_Object *get_buffer_line_list(void *, int, Scheme_Object **); |
| 93 | static Scheme_Object *get_buffer_name(void *, int, Scheme_Object **); |
| 94 | static Scheme_Object *get_buffer_num(void *, int, Scheme_Object **); |
| 95 | static Scheme_Object *get_buffer_size(void *, int, Scheme_Object **); |
| 96 | static Scheme_Object *get_curr_buffer(void *, int, Scheme_Object **); |
| 97 | static Scheme_Object *get_next_buffer(void *, int, Scheme_Object **); |
| 98 | static Scheme_Object *get_prev_buffer(void *, int, Scheme_Object **); |
| 99 | static Scheme_Object *mzscheme_open_buffer(void *, int, Scheme_Object **); |
| 100 | static Scheme_Object *set_buffer_line(void *, int, Scheme_Object **); |
| 101 | static Scheme_Object *set_buffer_line_list(void *, int, Scheme_Object **); |
| 102 | static Scheme_Object *insert_buffer_line_list(void *, int, Scheme_Object **); |
| 103 | static Scheme_Object *get_range_start(void *, int, Scheme_Object **); |
| 104 | static Scheme_Object *get_range_end(void *, int, Scheme_Object **); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 105 | static vim_mz_buffer *get_vim_curr_buffer(void); |
| 106 | |
| 107 | /* Window-related commands */ |
| 108 | static Scheme_Object *window_new(win_T *win); |
| 109 | static Scheme_Object *get_curr_win(void *, int, Scheme_Object **); |
| 110 | static Scheme_Object *get_window_count(void *, int, Scheme_Object **); |
| 111 | static Scheme_Object *get_window_by_num(void *, int, Scheme_Object **); |
| 112 | static Scheme_Object *get_window_num(void *, int, Scheme_Object **); |
| 113 | static Scheme_Object *get_window_buffer(void *, int, Scheme_Object **); |
| 114 | static Scheme_Object *get_window_height(void *, int, Scheme_Object **); |
| 115 | static Scheme_Object *set_window_height(void *, int, Scheme_Object **); |
| 116 | #ifdef FEAT_VERTSPLIT |
| 117 | static Scheme_Object *get_window_width(void *, int, Scheme_Object **); |
| 118 | static Scheme_Object *set_window_width(void *, int, Scheme_Object **); |
| 119 | #endif |
| 120 | static Scheme_Object *get_cursor(void *, int, Scheme_Object **); |
| 121 | static Scheme_Object *set_cursor(void *, int, Scheme_Object **); |
| 122 | static Scheme_Object *get_window_list(void *, int, Scheme_Object **); |
| 123 | static vim_mz_window *get_vim_curr_window(void); |
| 124 | |
| 125 | /* Vim-related commands */ |
| 126 | static Scheme_Object *mzscheme_beep(void *, int, Scheme_Object **); |
| 127 | static Scheme_Object *get_option(void *, int, Scheme_Object **); |
| 128 | static Scheme_Object *set_option(void *, int, Scheme_Object **); |
| 129 | static Scheme_Object *vim_command(void *, int, Scheme_Object **); |
| 130 | static Scheme_Object *vim_eval(void *, int, Scheme_Object **); |
| 131 | static Scheme_Object *vim_bufferp(void *data, int, Scheme_Object **); |
| 132 | static Scheme_Object *vim_windowp(void *data, int, Scheme_Object **); |
| 133 | static Scheme_Object *vim_buffer_validp(void *data, int, Scheme_Object **); |
| 134 | static Scheme_Object *vim_window_validp(void *data, int, Scheme_Object **); |
| 135 | |
| 136 | /* |
| 137 | *======================================================================== |
| 138 | * Internal Function Prototypes |
| 139 | *======================================================================== |
| 140 | */ |
| 141 | static int vim_error_check(void); |
| 142 | static int do_mzscheme_command(exarg_T *, void *, Scheme_Closed_Prim *what); |
| 143 | static void startup_mzscheme(void); |
| 144 | static char *string_to_line(Scheme_Object *obj); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 145 | static void do_output(char *mesg, long len); |
| 146 | static void do_printf(char *format, ...); |
| 147 | static void do_flush(void); |
| 148 | static Scheme_Object *_apply_thunk_catch_exceptions( |
| 149 | Scheme_Object *, Scheme_Object **); |
| 150 | static Scheme_Object *extract_exn_message(Scheme_Object *v); |
| 151 | static Scheme_Object *do_eval(void *, int noargc, Scheme_Object **noargv); |
| 152 | static Scheme_Object *do_load(void *, int noargc, Scheme_Object **noargv); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 153 | static void register_vim_exn(void); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 154 | static vim_mz_buffer *get_buffer_arg(const char *fname, int argnum, |
| 155 | int argc, Scheme_Object **argv); |
| 156 | static vim_mz_window *get_window_arg(const char *fname, int argnum, |
| 157 | int argc, Scheme_Object **argv); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 158 | static int line_in_range(linenr_T, buf_T *); |
| 159 | static void check_line_range(linenr_T, buf_T *); |
| 160 | static void mz_fix_cursor(int lo, int hi, int extra); |
| 161 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 162 | static int eval_with_exn_handling(void *, Scheme_Closed_Prim *, |
| 163 | Scheme_Object **ret); |
| 164 | static void make_modules(void); |
| 165 | static void init_exn_catching_apply(void); |
| 166 | static int mzscheme_env_main(Scheme_Env *env, int argc, char **argv); |
| 167 | static int mzscheme_init(void); |
| 168 | #ifdef FEAT_EVAL |
| 169 | static Scheme_Object *vim_to_mzscheme(typval_T *vim_value, int depth, |
| 170 | Scheme_Hash_Table *visited); |
Bram Moolenaar | 7e506b6 | 2010-01-19 15:55:06 +0100 | [diff] [blame] | 171 | static int mzscheme_to_vim(Scheme_Object *obj, typval_T *tv, int depth, |
| 172 | Scheme_Hash_Table *visited); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 173 | #endif |
| 174 | |
| 175 | #ifdef MZ_PRECISE_GC |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 176 | static int buffer_size_proc(void *obj UNUSED) |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 177 | { |
| 178 | return gcBYTES_TO_WORDS(sizeof(vim_mz_buffer)); |
| 179 | } |
| 180 | static int buffer_mark_proc(void *obj) |
| 181 | { |
| 182 | return buffer_size_proc(obj); |
| 183 | } |
| 184 | static int buffer_fixup_proc(void *obj) |
| 185 | { |
| 186 | return buffer_size_proc(obj); |
| 187 | } |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 188 | static int window_size_proc(void *obj UNUSED) |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 189 | { |
| 190 | return gcBYTES_TO_WORDS(sizeof(vim_mz_window)); |
| 191 | } |
| 192 | static int window_mark_proc(void *obj) |
| 193 | { |
| 194 | return window_size_proc(obj); |
| 195 | } |
| 196 | static int window_fixup_proc(void *obj) |
| 197 | { |
| 198 | return window_size_proc(obj); |
| 199 | } |
| 200 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 201 | |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 202 | #ifdef DYNAMIC_MZSCHEME |
| 203 | |
| 204 | static Scheme_Object *dll_scheme_eof; |
| 205 | static Scheme_Object *dll_scheme_false; |
| 206 | static Scheme_Object *dll_scheme_void; |
| 207 | static Scheme_Object *dll_scheme_null; |
| 208 | static Scheme_Object *dll_scheme_true; |
| 209 | |
| 210 | static Scheme_Thread **dll_scheme_current_thread_ptr; |
| 211 | |
| 212 | static void (**dll_scheme_console_printf_ptr)(char *str, ...); |
| 213 | static void (**dll_scheme_console_output_ptr)(char *str, long len); |
| 214 | static void (**dll_scheme_notify_multithread_ptr)(int on); |
| 215 | |
| 216 | static void *(*dll_GC_malloc)(size_t size_in_bytes); |
| 217 | static void *(*dll_GC_malloc_atomic)(size_t size_in_bytes); |
| 218 | static Scheme_Env *(*dll_scheme_basic_env)(void); |
| 219 | static void (*dll_scheme_check_threads)(void); |
| 220 | static void (*dll_scheme_register_static)(void *ptr, long size); |
| 221 | static void (*dll_scheme_set_stack_base)(void *base, int no_auto_statics); |
| 222 | static void (*dll_scheme_add_global)(const char *name, Scheme_Object *val, |
| 223 | Scheme_Env *env); |
| 224 | static void (*dll_scheme_add_global_symbol)(Scheme_Object *name, |
| 225 | Scheme_Object *val, Scheme_Env *env); |
| 226 | static Scheme_Object *(*dll_scheme_apply)(Scheme_Object *rator, int num_rands, |
| 227 | Scheme_Object **rands); |
| 228 | static Scheme_Object *(*dll_scheme_builtin_value)(const char *name); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 229 | # if MZSCHEME_VERSION_MAJOR >= 299 |
| 230 | static Scheme_Object *(*dll_scheme_byte_string_to_char_string)(Scheme_Object *s); |
| 231 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 232 | static void (*dll_scheme_close_input_port)(Scheme_Object *port); |
| 233 | static void (*dll_scheme_count_lines)(Scheme_Object *port); |
Bram Moolenaar | 049377e | 2007-05-12 15:32:12 +0000 | [diff] [blame] | 234 | #if MZSCHEME_VERSION_MAJOR < 360 |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 235 | static Scheme_Object *(*dll_scheme_current_continuation_marks)(void); |
Bram Moolenaar | 049377e | 2007-05-12 15:32:12 +0000 | [diff] [blame] | 236 | #else |
| 237 | static Scheme_Object *(*dll_scheme_current_continuation_marks)(Scheme_Object *prompt_tag); |
| 238 | #endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 239 | static void (*dll_scheme_display)(Scheme_Object *obj, Scheme_Object *port); |
| 240 | static char *(*dll_scheme_display_to_string)(Scheme_Object *obj, long *len); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 241 | static int (*dll_scheme_eq)(Scheme_Object *obj1, Scheme_Object *obj2); |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 242 | static Scheme_Object *(*dll_scheme_do_eval)(Scheme_Object *obj, |
| 243 | int _num_rands, Scheme_Object **rands, int val); |
| 244 | static void (*dll_scheme_dont_gc_ptr)(void *p); |
| 245 | static Scheme_Object *(*dll_scheme_eval)(Scheme_Object *obj, Scheme_Env *env); |
| 246 | static Scheme_Object *(*dll_scheme_eval_string)(const char *str, |
| 247 | Scheme_Env *env); |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 248 | static Scheme_Object *(*dll_scheme_eval_string_all)(const char *str, |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 249 | Scheme_Env *env, int all); |
| 250 | static void (*dll_scheme_finish_primitive_module)(Scheme_Env *env); |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 251 | # if MZSCHEME_VERSION_MAJOR < 299 |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 252 | static char *(*dll_scheme_format)(char *format, int flen, int argc, |
| 253 | Scheme_Object **argv, long *rlen); |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 254 | # else |
| 255 | static char *(*dll_scheme_format_utf8)(char *format, int flen, int argc, |
| 256 | Scheme_Object **argv, long *rlen); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 257 | static Scheme_Object *(*dll_scheme_get_param)(Scheme_Config *c, int pos); |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 258 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 259 | static void (*dll_scheme_gc_ptr_ok)(void *p); |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 260 | # if MZSCHEME_VERSION_MAJOR < 299 |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 261 | static char *(*dll_scheme_get_sized_string_output)(Scheme_Object *, |
| 262 | long *len); |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 263 | # else |
| 264 | static char *(*dll_scheme_get_sized_byte_string_output)(Scheme_Object *, |
| 265 | long *len); |
| 266 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 267 | static Scheme_Object *(*dll_scheme_intern_symbol)(const char *name); |
| 268 | static Scheme_Object *(*dll_scheme_lookup_global)(Scheme_Object *symbol, |
| 269 | Scheme_Env *env); |
| 270 | static Scheme_Object *(*dll_scheme_make_closed_prim_w_arity) |
| 271 | (Scheme_Closed_Prim *prim, void *data, const char *name, mzshort mina, |
| 272 | mzshort maxa); |
| 273 | static Scheme_Object *(*dll_scheme_make_integer_value)(long i); |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 274 | static Scheme_Object *(*dll_scheme_make_pair)(Scheme_Object *car, |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 275 | Scheme_Object *cdr); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 276 | static Scheme_Object *(*dll_scheme_make_prim_w_arity)(Scheme_Prim *prim, |
| 277 | const char *name, mzshort mina, mzshort maxa); |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 278 | # if MZSCHEME_VERSION_MAJOR < 299 |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 279 | static Scheme_Object *(*dll_scheme_make_string)(const char *chars); |
| 280 | static Scheme_Object *(*dll_scheme_make_string_output_port)(); |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 281 | # else |
| 282 | static Scheme_Object *(*dll_scheme_make_byte_string)(const char *chars); |
| 283 | static Scheme_Object *(*dll_scheme_make_byte_string_output_port)(); |
| 284 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 285 | static Scheme_Object *(*dll_scheme_make_struct_instance)(Scheme_Object *stype, |
| 286 | int argc, Scheme_Object **argv); |
| 287 | static Scheme_Object **(*dll_scheme_make_struct_names)(Scheme_Object *base, |
| 288 | Scheme_Object *field_names, int flags, int *count_out); |
| 289 | static Scheme_Object *(*dll_scheme_make_struct_type)(Scheme_Object *base, |
| 290 | Scheme_Object *parent, Scheme_Object *inspector, int num_fields, |
| 291 | int num_uninit_fields, Scheme_Object *uninit_val, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 292 | Scheme_Object *properties |
| 293 | # if MZSCHEME_VERSION_MAJOR >= 299 |
| 294 | , Scheme_Object *guard |
| 295 | # endif |
| 296 | ); |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 297 | static Scheme_Object **(*dll_scheme_make_struct_values)( |
| 298 | Scheme_Object *struct_type, Scheme_Object **names, int count, |
| 299 | int flags); |
| 300 | static Scheme_Type (*dll_scheme_make_type)(const char *name); |
| 301 | static Scheme_Object *(*dll_scheme_make_vector)(int size, |
| 302 | Scheme_Object *fill); |
| 303 | static void *(*dll_scheme_malloc_fail_ok)(void *(*f)(size_t), size_t); |
| 304 | static Scheme_Object *(*dll_scheme_open_input_file)(const char *name, |
| 305 | const char *who); |
| 306 | static Scheme_Env *(*dll_scheme_primitive_module)(Scheme_Object *name, |
| 307 | Scheme_Env *for_env); |
| 308 | static int (*dll_scheme_proper_list_length)(Scheme_Object *list); |
| 309 | static void (*dll_scheme_raise)(Scheme_Object *exn); |
| 310 | static Scheme_Object *(*dll_scheme_read)(Scheme_Object *port); |
| 311 | static void (*dll_scheme_signal_error)(const char *msg, ...); |
| 312 | static void (*dll_scheme_wrong_type)(const char *name, const char *expected, |
| 313 | int which, int argc, Scheme_Object **argv); |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 314 | # if MZSCHEME_VERSION_MAJOR >= 299 |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 315 | static void (*dll_scheme_set_param)(Scheme_Config *c, int pos, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 316 | Scheme_Object *o); |
| 317 | static Scheme_Config *(*dll_scheme_current_config)(void); |
| 318 | static Scheme_Object *(*dll_scheme_char_string_to_byte_string) |
| 319 | (Scheme_Object *s); |
Bram Moolenaar | e2a49d8 | 2007-07-06 17:43:08 +0000 | [diff] [blame] | 320 | static Scheme_Object *(*dll_scheme_char_string_to_path) |
| 321 | (Scheme_Object *s); |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 322 | # endif |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 323 | static Scheme_Hash_Table *(*dll_scheme_make_hash_table)(int type); |
| 324 | static void (*dll_scheme_hash_set)(Scheme_Hash_Table *table, |
| 325 | Scheme_Object *key, Scheme_Object *value); |
| 326 | static Scheme_Object *(*dll_scheme_hash_get)(Scheme_Hash_Table *table, |
| 327 | Scheme_Object *key); |
| 328 | static Scheme_Object *(*dll_scheme_make_double)(double d); |
| 329 | # ifdef INCLUDE_MZSCHEME_BASE |
| 330 | static Scheme_Object *(*dll_scheme_make_sized_byte_string)(char *chars, |
| 331 | long len, int copy); |
| 332 | static Scheme_Object *(*dll_scheme_namespace_require)(Scheme_Object *req); |
| 333 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 334 | |
| 335 | /* arrays are imported directly */ |
| 336 | # define scheme_eof dll_scheme_eof |
| 337 | # define scheme_false dll_scheme_false |
| 338 | # define scheme_void dll_scheme_void |
| 339 | # define scheme_null dll_scheme_null |
| 340 | # define scheme_true dll_scheme_true |
| 341 | |
| 342 | /* pointers are GetProceAddress'ed as pointers to pointer */ |
| 343 | # define scheme_current_thread (*dll_scheme_current_thread_ptr) |
| 344 | # define scheme_console_printf (*dll_scheme_console_printf_ptr) |
| 345 | # define scheme_console_output (*dll_scheme_console_output_ptr) |
| 346 | # define scheme_notify_multithread (*dll_scheme_notify_multithread_ptr) |
| 347 | |
| 348 | /* and functions in a usual way */ |
| 349 | # define GC_malloc dll_GC_malloc |
| 350 | # define GC_malloc_atomic dll_GC_malloc_atomic |
| 351 | |
| 352 | # define scheme_add_global dll_scheme_add_global |
| 353 | # define scheme_add_global_symbol dll_scheme_add_global_symbol |
| 354 | # define scheme_apply dll_scheme_apply |
| 355 | # define scheme_basic_env dll_scheme_basic_env |
| 356 | # define scheme_builtin_value dll_scheme_builtin_value |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 357 | # if MZSCHEME_VERSION_MAJOR >= 299 |
| 358 | # define scheme_byte_string_to_char_string dll_scheme_byte_string_to_char_string |
| 359 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 360 | # define scheme_check_threads dll_scheme_check_threads |
| 361 | # define scheme_close_input_port dll_scheme_close_input_port |
| 362 | # define scheme_count_lines dll_scheme_count_lines |
| 363 | # define scheme_current_continuation_marks \ |
| 364 | dll_scheme_current_continuation_marks |
| 365 | # define scheme_display dll_scheme_display |
| 366 | # define scheme_display_to_string dll_scheme_display_to_string |
| 367 | # define scheme_do_eval dll_scheme_do_eval |
| 368 | # define scheme_dont_gc_ptr dll_scheme_dont_gc_ptr |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 369 | # define scheme_eq dll_scheme_eq |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 370 | # define scheme_eval dll_scheme_eval |
| 371 | # define scheme_eval_string dll_scheme_eval_string |
| 372 | # define scheme_eval_string_all dll_scheme_eval_string_all |
| 373 | # define scheme_finish_primitive_module dll_scheme_finish_primitive_module |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 374 | # if MZSCHEME_VERSION_MAJOR < 299 |
| 375 | # define scheme_format dll_scheme_format |
| 376 | # else |
| 377 | # define scheme_format_utf8 dll_scheme_format_utf8 |
| 378 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 379 | # define scheme_gc_ptr_ok dll_scheme_gc_ptr_ok |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 380 | # if MZSCHEME_VERSION_MAJOR < 299 |
| 381 | # define scheme_get_sized_string_output dll_scheme_get_sized_string_output |
| 382 | # else |
| 383 | # define scheme_get_sized_byte_string_output \ |
| 384 | dll_scheme_get_sized_byte_string_output |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 385 | # define scheme_get_param dll_scheme_get_param |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 386 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 387 | # define scheme_intern_symbol dll_scheme_intern_symbol |
| 388 | # define scheme_lookup_global dll_scheme_lookup_global |
| 389 | # define scheme_make_closed_prim_w_arity dll_scheme_make_closed_prim_w_arity |
| 390 | # define scheme_make_integer_value dll_scheme_make_integer_value |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 391 | # define scheme_make_pair dll_scheme_make_pair |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 392 | # define scheme_make_prim_w_arity dll_scheme_make_prim_w_arity |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 393 | # if MZSCHEME_VERSION_MAJOR < 299 |
| 394 | # define scheme_make_string dll_scheme_make_string |
| 395 | # define scheme_make_string_output_port dll_scheme_make_string_output_port |
| 396 | # else |
| 397 | # define scheme_make_byte_string dll_scheme_make_byte_string |
| 398 | # define scheme_make_byte_string_output_port \ |
| 399 | dll_scheme_make_byte_string_output_port |
| 400 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 401 | # define scheme_make_struct_instance dll_scheme_make_struct_instance |
| 402 | # define scheme_make_struct_names dll_scheme_make_struct_names |
| 403 | # define scheme_make_struct_type dll_scheme_make_struct_type |
| 404 | # define scheme_make_struct_values dll_scheme_make_struct_values |
| 405 | # define scheme_make_type dll_scheme_make_type |
| 406 | # define scheme_make_vector dll_scheme_make_vector |
| 407 | # define scheme_malloc_fail_ok dll_scheme_malloc_fail_ok |
| 408 | # define scheme_open_input_file dll_scheme_open_input_file |
| 409 | # define scheme_primitive_module dll_scheme_primitive_module |
| 410 | # define scheme_proper_list_length dll_scheme_proper_list_length |
| 411 | # define scheme_raise dll_scheme_raise |
| 412 | # define scheme_read dll_scheme_read |
| 413 | # define scheme_register_static dll_scheme_register_static |
| 414 | # define scheme_set_stack_base dll_scheme_set_stack_base |
| 415 | # define scheme_signal_error dll_scheme_signal_error |
| 416 | # define scheme_wrong_type dll_scheme_wrong_type |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 417 | # if MZSCHEME_VERSION_MAJOR >= 299 |
| 418 | # define scheme_set_param dll_scheme_set_param |
| 419 | # define scheme_current_config dll_scheme_current_config |
| 420 | # define scheme_char_string_to_byte_string \ |
| 421 | dll_scheme_char_string_to_byte_string |
Bram Moolenaar | e2a49d8 | 2007-07-06 17:43:08 +0000 | [diff] [blame] | 422 | # define scheme_char_string_to_path \ |
| 423 | dll_scheme_char_string_to_path |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 424 | # endif |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 425 | # define scheme_make_hash_table dll_scheme_make_hash_table |
| 426 | # define scheme_hash_set dll_scheme_hash_set |
| 427 | # define scheme_hash_get dll_scheme_hash_get |
| 428 | # define scheme_make_double dll_scheme_make_double |
| 429 | # ifdef INCLUDE_MZSCHEME_BASE |
| 430 | # define scheme_make_sized_byte_string dll_scheme_make_sized_byte_string |
| 431 | # define scheme_namespace_require dll_scheme_namespace_require |
| 432 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 433 | |
| 434 | typedef struct |
| 435 | { |
| 436 | char *name; |
| 437 | void **ptr; |
| 438 | } Thunk_Info; |
| 439 | |
| 440 | static Thunk_Info mzgc_imports[] = { |
| 441 | {"GC_malloc", (void **)&dll_GC_malloc}, |
| 442 | {"GC_malloc_atomic", (void **)&dll_GC_malloc_atomic}, |
| 443 | {NULL, NULL}}; |
| 444 | |
| 445 | static Thunk_Info mzsch_imports[] = { |
| 446 | {"scheme_eof", (void **)&dll_scheme_eof}, |
| 447 | {"scheme_false", (void **)&dll_scheme_false}, |
| 448 | {"scheme_void", (void **)&dll_scheme_void}, |
| 449 | {"scheme_null", (void **)&dll_scheme_null}, |
| 450 | {"scheme_true", (void **)&dll_scheme_true}, |
| 451 | {"scheme_current_thread", (void **)&dll_scheme_current_thread_ptr}, |
| 452 | {"scheme_console_printf", (void **)&dll_scheme_console_printf_ptr}, |
| 453 | {"scheme_console_output", (void **)&dll_scheme_console_output_ptr}, |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 454 | {"scheme_notify_multithread", |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 455 | (void **)&dll_scheme_notify_multithread_ptr}, |
| 456 | {"scheme_add_global", (void **)&dll_scheme_add_global}, |
| 457 | {"scheme_add_global_symbol", (void **)&dll_scheme_add_global_symbol}, |
| 458 | {"scheme_apply", (void **)&dll_scheme_apply}, |
| 459 | {"scheme_basic_env", (void **)&dll_scheme_basic_env}, |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 460 | # if MZSCHEME_VERSION_MAJOR >= 299 |
| 461 | {"scheme_byte_string_to_char_string", (void **)&dll_scheme_byte_string_to_char_string}, |
| 462 | # endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 463 | {"scheme_builtin_value", (void **)&dll_scheme_builtin_value}, |
| 464 | {"scheme_check_threads", (void **)&dll_scheme_check_threads}, |
| 465 | {"scheme_close_input_port", (void **)&dll_scheme_close_input_port}, |
| 466 | {"scheme_count_lines", (void **)&dll_scheme_count_lines}, |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 467 | {"scheme_current_continuation_marks", |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 468 | (void **)&dll_scheme_current_continuation_marks}, |
| 469 | {"scheme_display", (void **)&dll_scheme_display}, |
| 470 | {"scheme_display_to_string", (void **)&dll_scheme_display_to_string}, |
| 471 | {"scheme_do_eval", (void **)&dll_scheme_do_eval}, |
| 472 | {"scheme_dont_gc_ptr", (void **)&dll_scheme_dont_gc_ptr}, |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 473 | {"scheme_eq", (void **)&dll_scheme_eq}, |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 474 | {"scheme_eval", (void **)&dll_scheme_eval}, |
| 475 | {"scheme_eval_string", (void **)&dll_scheme_eval_string}, |
| 476 | {"scheme_eval_string_all", (void **)&dll_scheme_eval_string_all}, |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 477 | {"scheme_finish_primitive_module", |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 478 | (void **)&dll_scheme_finish_primitive_module}, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 479 | # if MZSCHEME_VERSION_MAJOR < 299 |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 480 | {"scheme_format", (void **)&dll_scheme_format}, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 481 | # else |
| 482 | {"scheme_format_utf8", (void **)&dll_scheme_format_utf8}, |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 483 | {"scheme_get_param", (void **)&dll_scheme_get_param}, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 484 | #endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 485 | {"scheme_gc_ptr_ok", (void **)&dll_scheme_gc_ptr_ok}, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 486 | # if MZSCHEME_VERSION_MAJOR < 299 |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 487 | {"scheme_get_sized_string_output", |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 488 | (void **)&dll_scheme_get_sized_string_output}, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 489 | # else |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 490 | {"scheme_get_sized_byte_string_output", |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 491 | (void **)&dll_scheme_get_sized_byte_string_output}, |
| 492 | #endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 493 | {"scheme_intern_symbol", (void **)&dll_scheme_intern_symbol}, |
| 494 | {"scheme_lookup_global", (void **)&dll_scheme_lookup_global}, |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 495 | {"scheme_make_closed_prim_w_arity", |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 496 | (void **)&dll_scheme_make_closed_prim_w_arity}, |
| 497 | {"scheme_make_integer_value", (void **)&dll_scheme_make_integer_value}, |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 498 | {"scheme_make_pair", (void **)&dll_scheme_make_pair}, |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 499 | {"scheme_make_prim_w_arity", (void **)&dll_scheme_make_prim_w_arity}, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 500 | # if MZSCHEME_VERSION_MAJOR < 299 |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 501 | {"scheme_make_string", (void **)&dll_scheme_make_string}, |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 502 | {"scheme_make_string_output_port", |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 503 | (void **)&dll_scheme_make_string_output_port}, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 504 | # else |
| 505 | {"scheme_make_byte_string", (void **)&dll_scheme_make_byte_string}, |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 506 | {"scheme_make_byte_string_output_port", |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 507 | (void **)&dll_scheme_make_byte_string_output_port}, |
| 508 | # endif |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 509 | {"scheme_make_struct_instance", |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 510 | (void **)&dll_scheme_make_struct_instance}, |
| 511 | {"scheme_make_struct_names", (void **)&dll_scheme_make_struct_names}, |
| 512 | {"scheme_make_struct_type", (void **)&dll_scheme_make_struct_type}, |
| 513 | {"scheme_make_struct_values", (void **)&dll_scheme_make_struct_values}, |
| 514 | {"scheme_make_type", (void **)&dll_scheme_make_type}, |
| 515 | {"scheme_make_vector", (void **)&dll_scheme_make_vector}, |
| 516 | {"scheme_malloc_fail_ok", (void **)&dll_scheme_malloc_fail_ok}, |
| 517 | {"scheme_open_input_file", (void **)&dll_scheme_open_input_file}, |
| 518 | {"scheme_primitive_module", (void **)&dll_scheme_primitive_module}, |
| 519 | {"scheme_proper_list_length", (void **)&dll_scheme_proper_list_length}, |
| 520 | {"scheme_raise", (void **)&dll_scheme_raise}, |
| 521 | {"scheme_read", (void **)&dll_scheme_read}, |
| 522 | {"scheme_register_static", (void **)&dll_scheme_register_static}, |
| 523 | {"scheme_set_stack_base", (void **)&dll_scheme_set_stack_base}, |
| 524 | {"scheme_signal_error", (void **)&dll_scheme_signal_error}, |
| 525 | {"scheme_wrong_type", (void **)&dll_scheme_wrong_type}, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 526 | # if MZSCHEME_VERSION_MAJOR >= 299 |
| 527 | {"scheme_set_param", (void **)&dll_scheme_set_param}, |
| 528 | {"scheme_current_config", (void **)&dll_scheme_current_config}, |
| 529 | {"scheme_char_string_to_byte_string", |
| 530 | (void **)&dll_scheme_char_string_to_byte_string}, |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 531 | {"scheme_char_string_to_path", (void **)&dll_scheme_char_string_to_path}, |
Bram Moolenaar | 2e6aff3 | 2005-01-31 19:25:36 +0000 | [diff] [blame] | 532 | # endif |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 533 | {"scheme_make_hash_table", (void **)&dll_scheme_make_hash_table}, |
| 534 | {"scheme_hash_set", (void **)&dll_scheme_hash_set}, |
| 535 | {"scheme_hash_get", (void **)&dll_scheme_hash_get}, |
| 536 | {"scheme_make_double", (void **)&dll_scheme_make_double}, |
| 537 | # ifdef INCLUDE_MZSCHEME_BASE |
| 538 | {"scheme_make_sized_byte_string", (void **)&dll_scheme_make_sized_byte_string}, |
| 539 | {"scheme_namespace_require", (void **)&dll_scheme_namespace_require}, |
| 540 | #endif |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 541 | {NULL, NULL}}; |
| 542 | |
| 543 | static HINSTANCE hMzGC = 0; |
| 544 | static HINSTANCE hMzSch = 0; |
| 545 | |
| 546 | static void dynamic_mzscheme_end(void); |
| 547 | static int mzscheme_runtime_link_init(char *sch_dll, char *gc_dll, |
| 548 | int verbose); |
| 549 | |
| 550 | static int |
| 551 | mzscheme_runtime_link_init(char *sch_dll, char *gc_dll, int verbose) |
| 552 | { |
| 553 | Thunk_Info *thunk = NULL; |
| 554 | |
| 555 | if (hMzGC && hMzSch) |
| 556 | return OK; |
Bram Moolenaar | ebbcb82 | 2010-10-23 14:02:54 +0200 | [diff] [blame] | 557 | hMzSch = vimLoadLib(sch_dll); |
| 558 | hMzGC = vimLoadLib(gc_dll); |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 559 | |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 560 | if (!hMzGC) |
| 561 | { |
| 562 | if (verbose) |
| 563 | EMSG2(_(e_loadlib), gc_dll); |
| 564 | return FAIL; |
| 565 | } |
| 566 | |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 567 | if (!hMzSch) |
| 568 | { |
| 569 | if (verbose) |
| 570 | EMSG2(_(e_loadlib), sch_dll); |
| 571 | return FAIL; |
| 572 | } |
| 573 | |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 574 | for (thunk = mzsch_imports; thunk->name; thunk++) |
| 575 | { |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 576 | if ((*thunk->ptr = |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 577 | (void *)GetProcAddress(hMzSch, thunk->name)) == NULL) |
| 578 | { |
| 579 | FreeLibrary(hMzSch); |
| 580 | hMzSch = 0; |
| 581 | FreeLibrary(hMzGC); |
| 582 | hMzGC = 0; |
| 583 | if (verbose) |
| 584 | EMSG2(_(e_loadfunc), thunk->name); |
| 585 | return FAIL; |
| 586 | } |
| 587 | } |
| 588 | for (thunk = mzgc_imports; thunk->name; thunk++) |
| 589 | { |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 590 | if ((*thunk->ptr = |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 591 | (void *)GetProcAddress(hMzGC, thunk->name)) == NULL) |
| 592 | { |
| 593 | FreeLibrary(hMzSch); |
| 594 | hMzSch = 0; |
| 595 | FreeLibrary(hMzGC); |
| 596 | hMzGC = 0; |
| 597 | if (verbose) |
| 598 | EMSG2(_(e_loadfunc), thunk->name); |
| 599 | return FAIL; |
| 600 | } |
| 601 | } |
| 602 | return OK; |
| 603 | } |
| 604 | |
| 605 | int |
| 606 | mzscheme_enabled(int verbose) |
| 607 | { |
| 608 | return mzscheme_runtime_link_init( |
| 609 | DYNAMIC_MZSCH_DLL, DYNAMIC_MZGC_DLL, verbose) == OK; |
| 610 | } |
| 611 | |
| 612 | static void |
| 613 | dynamic_mzscheme_end(void) |
| 614 | { |
| 615 | if (hMzSch) |
| 616 | { |
| 617 | FreeLibrary(hMzSch); |
| 618 | hMzSch = 0; |
| 619 | } |
| 620 | if (hMzGC) |
| 621 | { |
| 622 | FreeLibrary(hMzGC); |
| 623 | hMzGC = 0; |
| 624 | } |
| 625 | } |
| 626 | #endif /* DYNAMIC_MZSCHEME */ |
| 627 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 628 | /* need to put it here for dynamic stuff to work */ |
Bram Moolenaar | e484c94 | 2009-09-11 10:21:41 +0000 | [diff] [blame] | 629 | #if defined(INCLUDE_MZSCHEME_BASE) |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 630 | # include "mzscheme_base.c" |
Bram Moolenaar | e484c94 | 2009-09-11 10:21:41 +0000 | [diff] [blame] | 631 | #elif MZSCHEME_VERSION_MAJOR >= 400 |
| 632 | # error MzScheme 4.x must include mzscheme_base.c, for MinGW32 you need to define MZSCHEME_GENERATE_BASE=yes |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 633 | #endif |
| 634 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 635 | /* |
| 636 | *======================================================================== |
| 637 | * 1. MzScheme interpreter startup |
| 638 | *======================================================================== |
| 639 | */ |
| 640 | |
| 641 | static Scheme_Type mz_buffer_type; |
| 642 | static Scheme_Type mz_window_type; |
| 643 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 644 | static int initialized = FALSE; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 645 | |
| 646 | /* global environment */ |
| 647 | static Scheme_Env *environment = NULL; |
| 648 | /* output/error handlers */ |
| 649 | static Scheme_Object *curout = NULL; |
| 650 | static Scheme_Object *curerr = NULL; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 651 | /* exn:vim exception */ |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 652 | static Scheme_Object *exn_catching_apply = NULL; |
| 653 | static Scheme_Object *exn_p = NULL; |
| 654 | static Scheme_Object *exn_message = NULL; |
| 655 | static Scheme_Object *vim_exn = NULL; /* Vim Error exception */ |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 656 | |
| 657 | #if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400 |
| 658 | static void *stack_base = NULL; |
| 659 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 660 | |
| 661 | static long range_start; |
| 662 | static long range_end; |
| 663 | |
| 664 | /* MzScheme threads scheduling stuff */ |
| 665 | static int mz_threads_allow = 0; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 666 | |
| 667 | #if defined(FEAT_GUI_W32) |
| 668 | static void CALLBACK timer_proc(HWND, UINT, UINT, DWORD); |
| 669 | static UINT timer_id = 0; |
| 670 | #elif defined(FEAT_GUI_GTK) |
| 671 | static gint timer_proc(gpointer); |
| 672 | static guint timer_id = 0; |
| 673 | #elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA) |
| 674 | static void timer_proc(XtPointer, XtIntervalId *); |
| 675 | static XtIntervalId timer_id = (XtIntervalId)0; |
| 676 | #elif defined(FEAT_GUI_MAC) |
| 677 | pascal void timer_proc(EventLoopTimerRef, void *); |
| 678 | static EventLoopTimerRef timer_id = NULL; |
| 679 | static EventLoopTimerUPP timerUPP; |
| 680 | #endif |
| 681 | |
| 682 | #ifndef FEAT_GUI_W32 /* Win32 console and Unix */ |
| 683 | void |
| 684 | mzvim_check_threads(void) |
| 685 | { |
| 686 | /* Last time MzScheme threads were scheduled */ |
| 687 | static time_t mz_last_time = 0; |
| 688 | |
| 689 | if (mz_threads_allow && p_mzq > 0) |
| 690 | { |
| 691 | time_t now = time(NULL); |
| 692 | |
| 693 | if ((now - mz_last_time) * 1000 > p_mzq) |
| 694 | { |
| 695 | mz_last_time = now; |
| 696 | scheme_check_threads(); |
| 697 | } |
| 698 | } |
| 699 | } |
| 700 | #endif |
| 701 | |
Bram Moolenaar | 2df6dcc | 2004-07-12 15:53:54 +0000 | [diff] [blame] | 702 | #ifdef MZSCHEME_GUI_THREADS |
| 703 | static void setup_timer(void); |
| 704 | static void remove_timer(void); |
| 705 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 706 | /* timers are presented in GUI only */ |
| 707 | # if defined(FEAT_GUI_W32) |
| 708 | static void CALLBACK |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 709 | timer_proc(HWND hwnd UNUSED, UINT uMsg UNUSED, UINT idEvent UNUSED, DWORD dwTime UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 710 | # elif defined(FEAT_GUI_GTK) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 711 | static gint |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 712 | timer_proc(gpointer data UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 713 | # elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 714 | static void |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 715 | timer_proc(XtPointer timed_out UNUSED, XtIntervalId *interval_id UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 716 | # elif defined(FEAT_GUI_MAC) |
| 717 | pascal void |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 718 | timer_proc(EventLoopTimerRef theTimer UNUSED, void *userData UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 719 | # endif |
| 720 | { |
| 721 | scheme_check_threads(); |
| 722 | # if defined(FEAT_GUI_GTK) |
| 723 | return TRUE; /* continue receiving notifications */ |
| 724 | # elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA) |
| 725 | /* renew timeout */ |
| 726 | if (mz_threads_allow && p_mzq > 0) |
| 727 | timer_id = XtAppAddTimeOut(app_context, p_mzq, |
| 728 | timer_proc, NULL); |
| 729 | # endif |
| 730 | } |
| 731 | |
| 732 | static void |
| 733 | setup_timer(void) |
| 734 | { |
| 735 | # if defined(FEAT_GUI_W32) |
| 736 | timer_id = SetTimer(NULL, 0, p_mzq, timer_proc); |
| 737 | # elif defined(FEAT_GUI_GTK) |
| 738 | timer_id = gtk_timeout_add((guint32)p_mzq, (GtkFunction)timer_proc, NULL); |
| 739 | # elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA) |
| 740 | timer_id = XtAppAddTimeOut(app_context, p_mzq, timer_proc, NULL); |
| 741 | # elif defined(FEAT_GUI_MAC) |
| 742 | timerUPP = NewEventLoopTimerUPP(timer_proc); |
| 743 | InstallEventLoopTimer(GetMainEventLoop(), p_mzq * kEventDurationMillisecond, |
| 744 | p_mzq * kEventDurationMillisecond, timerUPP, NULL, &timer_id); |
| 745 | # endif |
| 746 | } |
| 747 | |
| 748 | static void |
| 749 | remove_timer(void) |
| 750 | { |
| 751 | # if defined(FEAT_GUI_W32) |
| 752 | KillTimer(NULL, timer_id); |
| 753 | # elif defined(FEAT_GUI_GTK) |
| 754 | gtk_timeout_remove(timer_id); |
| 755 | # elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA) |
| 756 | XtRemoveTimeOut(timer_id); |
| 757 | # elif defined(FEAT_GUI_MAC) |
| 758 | RemoveEventLoopTimer(timer_id); |
| 759 | DisposeEventLoopTimerUPP(timerUPP); |
| 760 | # endif |
| 761 | timer_id = 0; |
| 762 | } |
| 763 | |
| 764 | void |
| 765 | mzvim_reset_timer(void) |
| 766 | { |
| 767 | if (timer_id != 0) |
| 768 | remove_timer(); |
| 769 | if (mz_threads_allow && p_mzq > 0 && gui.in_use) |
| 770 | setup_timer(); |
| 771 | } |
| 772 | |
Bram Moolenaar | 2df6dcc | 2004-07-12 15:53:54 +0000 | [diff] [blame] | 773 | #endif /* MZSCHEME_GUI_THREADS */ |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 774 | |
| 775 | static void |
| 776 | notify_multithread(int on) |
| 777 | { |
| 778 | mz_threads_allow = on; |
Bram Moolenaar | 2df6dcc | 2004-07-12 15:53:54 +0000 | [diff] [blame] | 779 | #ifdef MZSCHEME_GUI_THREADS |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 780 | if (on && timer_id == 0 && p_mzq > 0 && gui.in_use) |
| 781 | setup_timer(); |
| 782 | if (!on && timer_id != 0) |
| 783 | remove_timer(); |
| 784 | #endif |
| 785 | } |
| 786 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 787 | void |
| 788 | mzscheme_end(void) |
| 789 | { |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 790 | #ifdef DYNAMIC_MZSCHEME |
| 791 | dynamic_mzscheme_end(); |
| 792 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 793 | } |
| 794 | |
Bram Moolenaar | 2d0860d | 2010-11-03 21:59:30 +0100 | [diff] [blame] | 795 | #if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) && defined(USE_THREAD_LOCAL) |
| 796 | static __declspec(thread) void *tls_space; |
| 797 | #endif |
| 798 | |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 799 | /* |
| 800 | * Since version 4.x precise GC requires trampolined startup. |
| 801 | * Futures and places in version 5.x need it too. |
| 802 | */ |
| 803 | #if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 \ |
| 804 | || MZSCHEME_VERSION_MAJOR >= 500 && (defined(MZ_USE_FUTURES) || defined(MZ_USE_PLACES)) |
| 805 | # ifdef DYNAMIC_MZSCHEME |
| 806 | # error Precise GC v.4+ or Racket with futures/places do not support dynamic MzScheme |
| 807 | # endif |
| 808 | # define TRAMPOLINED_MZVIM_STARTUP |
| 809 | #endif |
| 810 | |
| 811 | int |
| 812 | mzscheme_main(int argc, char** argv) |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 813 | { |
Bram Moolenaar | 2d0860d | 2010-11-03 21:59:30 +0100 | [diff] [blame] | 814 | #if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) && defined(USE_THREAD_LOCAL) |
| 815 | scheme_register_tls_space(&tls_space, 0); |
| 816 | #endif |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 817 | #ifdef TRAMPOLINED_MZVIM_STARTUP |
| 818 | return scheme_main_setup(TRUE, mzscheme_env_main, argc, argv); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 819 | #else |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 820 | return mzscheme_env_main(NULL, argc, argv); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 821 | #endif |
| 822 | } |
| 823 | |
| 824 | static int |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 825 | mzscheme_env_main(Scheme_Env *env, int argc, char **argv) |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 826 | { |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 827 | int vim_main_result; |
| 828 | #ifdef TRAMPOLINED_MZVIM_STARTUP |
| 829 | /* Scheme has created the environment for us */ |
| 830 | environment = env; |
| 831 | #else |
| 832 | # ifdef MZ_PRECISE_GC |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 833 | Scheme_Object *dummy = NULL; |
| 834 | MZ_GC_DECL_REG(1); |
| 835 | MZ_GC_VAR_IN_REG(0, dummy); |
| 836 | |
| 837 | stack_base = &__gc_var_stack__; |
| 838 | # else |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 839 | int dummy = 0; |
| 840 | stack_base = (void *)&dummy; |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 841 | # endif |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 842 | #endif |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 843 | |
| 844 | /* mzscheme_main is called as a trampoline from main. |
| 845 | * We trampoline into vim_main2 |
| 846 | * Passing argc, argv through from mzscheme_main |
| 847 | */ |
| 848 | vim_main_result = vim_main2(argc, argv); |
| 849 | #if !defined(TRAMPOLINED_MZVIM_STARTUP) && defined(MZ_PRECISE_GC) |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 850 | /* releasing dummy */ |
| 851 | MZ_GC_REG(); |
| 852 | MZ_GC_UNREG(); |
| 853 | #endif |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 854 | return vim_main_result; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 855 | } |
| 856 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 857 | static void |
| 858 | startup_mzscheme(void) |
| 859 | { |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 860 | #ifndef TRAMPOLINED_MZVIM_STARTUP |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 861 | scheme_set_stack_base(stack_base, 1); |
| 862 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 863 | |
| 864 | MZ_REGISTER_STATIC(environment); |
| 865 | MZ_REGISTER_STATIC(curout); |
| 866 | MZ_REGISTER_STATIC(curerr); |
| 867 | MZ_REGISTER_STATIC(exn_catching_apply); |
| 868 | MZ_REGISTER_STATIC(exn_p); |
| 869 | MZ_REGISTER_STATIC(exn_message); |
| 870 | MZ_REGISTER_STATIC(vim_exn); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 871 | |
Bram Moolenaar | bbc98db | 2012-02-12 01:55:55 +0100 | [diff] [blame] | 872 | #ifndef TRAMPOLINED_MZVIM_STARTUP |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 873 | /* in newer versions of precise GC the initial env has been created */ |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 874 | environment = scheme_basic_env(); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 875 | #endif |
| 876 | MZ_GC_CHECK(); |
| 877 | |
| 878 | #ifdef INCLUDE_MZSCHEME_BASE |
| 879 | { |
| 880 | /* |
Bram Moolenaar | e484c94 | 2009-09-11 10:21:41 +0000 | [diff] [blame] | 881 | * versions 4.x do not provide Scheme bindings by default |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 882 | * we need to add them explicitly |
| 883 | */ |
| 884 | Scheme_Object *scheme_base_symbol = NULL; |
| 885 | MZ_GC_DECL_REG(1); |
| 886 | MZ_GC_VAR_IN_REG(0, scheme_base_symbol); |
| 887 | MZ_GC_REG(); |
Bram Moolenaar | e484c94 | 2009-09-11 10:21:41 +0000 | [diff] [blame] | 888 | /* invoke function from generated and included mzscheme_base.c */ |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 889 | declare_modules(environment); |
| 890 | scheme_base_symbol = scheme_intern_symbol("scheme/base"); |
| 891 | MZ_GC_CHECK(); |
| 892 | scheme_namespace_require(scheme_base_symbol); |
| 893 | MZ_GC_CHECK(); |
| 894 | MZ_GC_UNREG(); |
| 895 | } |
| 896 | #endif |
| 897 | register_vim_exn(); |
| 898 | /* use new environment to initialise exception handling */ |
| 899 | init_exn_catching_apply(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 900 | |
| 901 | /* redirect output */ |
| 902 | scheme_console_output = do_output; |
| 903 | scheme_console_printf = do_printf; |
| 904 | |
| 905 | #ifdef MZSCHEME_COLLECTS |
| 906 | /* setup 'current-library-collection-paths' parameter */ |
Bram Moolenaar | e2a49d8 | 2007-07-06 17:43:08 +0000 | [diff] [blame] | 907 | # if MZSCHEME_VERSION_MAJOR >= 299 |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 908 | { |
| 909 | Scheme_Object *coll_byte_string = NULL; |
| 910 | Scheme_Object *coll_char_string = NULL; |
| 911 | Scheme_Object *coll_path = NULL; |
| 912 | Scheme_Object *coll_pair = NULL; |
| 913 | Scheme_Config *config = NULL; |
| 914 | |
| 915 | MZ_GC_DECL_REG(5); |
| 916 | MZ_GC_VAR_IN_REG(0, coll_byte_string); |
| 917 | MZ_GC_VAR_IN_REG(1, coll_char_string); |
| 918 | MZ_GC_VAR_IN_REG(2, coll_path); |
| 919 | MZ_GC_VAR_IN_REG(3, coll_pair); |
| 920 | MZ_GC_VAR_IN_REG(4, config); |
| 921 | MZ_GC_REG(); |
| 922 | coll_byte_string = scheme_make_byte_string(MZSCHEME_COLLECTS); |
| 923 | MZ_GC_CHECK(); |
| 924 | coll_char_string = scheme_byte_string_to_char_string(coll_byte_string); |
| 925 | MZ_GC_CHECK(); |
| 926 | coll_path = scheme_char_string_to_path(coll_char_string); |
| 927 | MZ_GC_CHECK(); |
| 928 | coll_pair = scheme_make_pair(coll_path, scheme_null); |
| 929 | MZ_GC_CHECK(); |
| 930 | config = scheme_config; |
| 931 | MZ_GC_CHECK(); |
| 932 | scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair); |
| 933 | MZ_GC_CHECK(); |
| 934 | MZ_GC_UNREG(); |
| 935 | } |
Bram Moolenaar | e2a49d8 | 2007-07-06 17:43:08 +0000 | [diff] [blame] | 936 | # else |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 937 | { |
| 938 | Scheme_Object *coll_string = NULL; |
| 939 | Scheme_Object *coll_pair = NULL; |
| 940 | Scheme_Config *config = NULL; |
| 941 | |
| 942 | MZ_GC_DECL_REG(3); |
| 943 | MZ_GC_VAR_IN_REG(0, coll_string); |
| 944 | MZ_GC_VAR_IN_REG(1, coll_pair); |
| 945 | MZ_GC_VAR_IN_REG(2, config); |
| 946 | MZ_GC_REG(); |
| 947 | coll_string = scheme_make_string(MZSCHEME_COLLECTS); |
| 948 | MZ_GC_CHECK(); |
| 949 | coll_pair = scheme_make_pair(coll_string, scheme_null); |
| 950 | MZ_GC_CHECK(); |
| 951 | config = scheme_config; |
| 952 | MZ_GC_CHECK(); |
| 953 | scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair); |
| 954 | MZ_GC_CHECK(); |
| 955 | MZ_GC_UNREG(); |
| 956 | } |
Bram Moolenaar | e2a49d8 | 2007-07-06 17:43:08 +0000 | [diff] [blame] | 957 | # endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 958 | #endif |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 959 | #ifdef HAVE_SANDBOX |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 960 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 961 | Scheme_Object *make_security_guard = NULL; |
| 962 | MZ_GC_DECL_REG(1); |
| 963 | MZ_GC_VAR_IN_REG(0, make_security_guard); |
| 964 | MZ_GC_REG(); |
| 965 | |
| 966 | #if MZSCHEME_VERSION_MAJOR < 400 |
| 967 | { |
| 968 | Scheme_Object *make_security_guard_symbol = NULL; |
| 969 | MZ_GC_DECL_REG(1); |
| 970 | MZ_GC_VAR_IN_REG(0, make_security_guard_symbol); |
| 971 | MZ_GC_REG(); |
| 972 | make_security_guard_symbol = scheme_intern_symbol("make-security-guard"); |
| 973 | MZ_GC_CHECK(); |
| 974 | make_security_guard = scheme_lookup_global( |
| 975 | make_security_guard_symbol, environment); |
| 976 | MZ_GC_UNREG(); |
| 977 | } |
| 978 | #else |
| 979 | make_security_guard = scheme_builtin_value("make-security-guard"); |
| 980 | MZ_GC_CHECK(); |
| 981 | #endif |
| 982 | |
| 983 | /* setup sandbox guards */ |
| 984 | if (make_security_guard != NULL) |
| 985 | { |
| 986 | Scheme_Object *args[3] = {NULL, NULL, NULL}; |
| 987 | Scheme_Object *guard = NULL; |
| 988 | Scheme_Config *config = NULL; |
| 989 | MZ_GC_DECL_REG(5); |
| 990 | MZ_GC_ARRAY_VAR_IN_REG(0, args, 3); |
| 991 | MZ_GC_VAR_IN_REG(3, guard); |
| 992 | MZ_GC_VAR_IN_REG(4, config); |
| 993 | MZ_GC_REG(); |
| 994 | config = scheme_config; |
| 995 | MZ_GC_CHECK(); |
| 996 | args[0] = scheme_get_param(config, MZCONFIG_SECURITY_GUARD); |
| 997 | MZ_GC_CHECK(); |
| 998 | args[1] = scheme_make_prim_w_arity(sandbox_file_guard, |
| 999 | "sandbox-file-guard", 3, 3); |
| 1000 | args[2] = scheme_make_prim_w_arity(sandbox_network_guard, |
| 1001 | "sandbox-network-guard", 4, 4); |
| 1002 | guard = scheme_apply(make_security_guard, 3, args); |
| 1003 | MZ_GC_CHECK(); |
| 1004 | scheme_set_param(config, MZCONFIG_SECURITY_GUARD, guard); |
| 1005 | MZ_GC_CHECK(); |
| 1006 | MZ_GC_UNREG(); |
| 1007 | } |
| 1008 | MZ_GC_UNREG(); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 1009 | } |
| 1010 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1011 | /* Create buffer and window types for use in Scheme code */ |
| 1012 | mz_buffer_type = scheme_make_type("<vim-buffer>"); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1013 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1014 | mz_window_type = scheme_make_type("<vim-window>"); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1015 | MZ_GC_CHECK(); |
| 1016 | #ifdef MZ_PRECISE_GC |
| 1017 | GC_register_traversers(mz_buffer_type, |
| 1018 | buffer_size_proc, buffer_mark_proc, buffer_fixup_proc, |
| 1019 | TRUE, TRUE); |
| 1020 | GC_register_traversers(mz_window_type, |
| 1021 | window_size_proc, window_mark_proc, window_fixup_proc, |
| 1022 | TRUE, TRUE); |
| 1023 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1024 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1025 | make_modules(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1026 | |
| 1027 | /* |
| 1028 | * setup callback to receive notifications |
| 1029 | * whether thread scheduling is (or not) required |
| 1030 | */ |
| 1031 | scheme_notify_multithread = notify_multithread; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1032 | } |
| 1033 | |
| 1034 | /* |
| 1035 | * This routine is called for each new invocation of MzScheme |
| 1036 | * to make sure things are properly initialized. |
| 1037 | */ |
| 1038 | static int |
| 1039 | mzscheme_init(void) |
| 1040 | { |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1041 | if (!initialized) |
| 1042 | { |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 1043 | #ifdef DYNAMIC_MZSCHEME |
| 1044 | if (!mzscheme_enabled(TRUE)) |
| 1045 | { |
Bram Moolenaar | b849e71 | 2009-06-24 15:51:37 +0000 | [diff] [blame] | 1046 | EMSG(_("E815: Sorry, this command is disabled, the MzScheme libraries could not be loaded.")); |
Bram Moolenaar | 3357092 | 2005-01-25 22:26:29 +0000 | [diff] [blame] | 1047 | return -1; |
| 1048 | } |
| 1049 | #endif |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1050 | startup_mzscheme(); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1051 | initialized = TRUE; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1052 | } |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1053 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1054 | Scheme_Config *config = NULL; |
| 1055 | MZ_GC_DECL_REG(1); |
| 1056 | MZ_GC_VAR_IN_REG(0, config); |
| 1057 | MZ_GC_REG(); |
| 1058 | config = scheme_config; |
| 1059 | MZ_GC_CHECK(); |
Bram Moolenaar | 0a1c0ec | 2009-12-16 18:02:47 +0000 | [diff] [blame] | 1060 | /* recreate ports each call effectively clearing these ones */ |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1061 | curout = scheme_make_string_output_port(); |
| 1062 | MZ_GC_CHECK(); |
| 1063 | curerr = scheme_make_string_output_port(); |
| 1064 | MZ_GC_CHECK(); |
| 1065 | scheme_set_param(config, MZCONFIG_OUTPUT_PORT, curout); |
| 1066 | MZ_GC_CHECK(); |
| 1067 | scheme_set_param(config, MZCONFIG_ERROR_PORT, curerr); |
| 1068 | MZ_GC_CHECK(); |
| 1069 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1070 | } |
| 1071 | |
| 1072 | return 0; |
| 1073 | } |
| 1074 | |
| 1075 | /* |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1076 | *======================================================================== |
| 1077 | * 2. External Interface |
| 1078 | *======================================================================== |
| 1079 | */ |
| 1080 | |
| 1081 | /* |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1082 | * Evaluate command with exception handling |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1083 | */ |
| 1084 | static int |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1085 | eval_with_exn_handling(void *data, Scheme_Closed_Prim *what, Scheme_Object **ret) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1086 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1087 | Scheme_Object *value = NULL; |
| 1088 | Scheme_Object *exn = NULL; |
| 1089 | Scheme_Object *prim = NULL; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1090 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1091 | MZ_GC_DECL_REG(3); |
| 1092 | MZ_GC_VAR_IN_REG(0, value); |
| 1093 | MZ_GC_VAR_IN_REG(1, exn); |
| 1094 | MZ_GC_VAR_IN_REG(2, prim); |
| 1095 | MZ_GC_REG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1096 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1097 | prim = scheme_make_closed_prim_w_arity(what, data, "mzvim", 0, 0); |
| 1098 | MZ_GC_CHECK(); |
| 1099 | value = _apply_thunk_catch_exceptions(prim, &exn); |
| 1100 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1101 | |
| 1102 | if (!value) |
| 1103 | { |
| 1104 | value = extract_exn_message(exn); |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1105 | /* Got an exn? */ |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1106 | if (value) |
| 1107 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1108 | scheme_display(value, curerr); /* Send to stderr-vim */ |
| 1109 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1110 | do_flush(); |
| 1111 | } |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1112 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1113 | /* `raise' was called on some arbitrary value */ |
| 1114 | return FAIL; |
| 1115 | } |
| 1116 | |
| 1117 | if (ret != NULL) /* if pointer to retval supported give it up */ |
| 1118 | *ret = value; |
| 1119 | /* Print any result, as long as it's not a void */ |
| 1120 | else if (!SCHEME_VOIDP(value)) |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1121 | { |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1122 | scheme_display(value, curout); /* Send to stdout-vim */ |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1123 | MZ_GC_CHECK(); |
| 1124 | } |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1125 | |
| 1126 | do_flush(); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1127 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1128 | return OK; |
| 1129 | } |
| 1130 | |
| 1131 | /* :mzscheme */ |
| 1132 | static int |
| 1133 | do_mzscheme_command(exarg_T *eap, void *data, Scheme_Closed_Prim *what) |
| 1134 | { |
| 1135 | if (mzscheme_init()) |
| 1136 | return FAIL; |
| 1137 | |
| 1138 | range_start = eap->line1; |
| 1139 | range_end = eap->line2; |
| 1140 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1141 | return eval_with_exn_handling(data, what, NULL); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1142 | } |
| 1143 | |
| 1144 | /* |
| 1145 | * Routine called by VIM when deleting a buffer |
| 1146 | */ |
| 1147 | void |
| 1148 | mzscheme_buffer_free(buf_T *buf) |
| 1149 | { |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1150 | if (buf->b_mzscheme_ref) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1151 | { |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1152 | vim_mz_buffer *bp; |
| 1153 | |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1154 | bp = buf->b_mzscheme_ref; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1155 | bp->buf = INVALID_BUFFER_VALUE; |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1156 | buf->b_mzscheme_ref = NULL; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1157 | scheme_gc_ptr_ok(bp); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1158 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1159 | } |
| 1160 | } |
| 1161 | |
| 1162 | /* |
| 1163 | * Routine called by VIM when deleting a Window |
| 1164 | */ |
| 1165 | void |
| 1166 | mzscheme_window_free(win_T *win) |
| 1167 | { |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1168 | if (win->w_mzscheme_ref) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1169 | { |
| 1170 | vim_mz_window *wp; |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1171 | wp = win->w_mzscheme_ref; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1172 | wp->win = INVALID_WINDOW_VALUE; |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1173 | win->w_mzscheme_ref = NULL; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1174 | scheme_gc_ptr_ok(wp); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1175 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1176 | } |
| 1177 | } |
| 1178 | |
| 1179 | /* |
| 1180 | * ":mzscheme" (or ":mz") |
| 1181 | */ |
| 1182 | void |
| 1183 | ex_mzscheme(exarg_T *eap) |
| 1184 | { |
| 1185 | char_u *script; |
| 1186 | |
| 1187 | script = script_get(eap, eap->arg); |
| 1188 | if (!eap->skip) |
| 1189 | { |
| 1190 | if (script == NULL) |
| 1191 | do_mzscheme_command(eap, eap->arg, do_eval); |
| 1192 | else |
| 1193 | { |
| 1194 | do_mzscheme_command(eap, script, do_eval); |
| 1195 | vim_free(script); |
| 1196 | } |
| 1197 | } |
| 1198 | } |
| 1199 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1200 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1201 | do_load(void *data, int noargc UNUSED, Scheme_Object **noargv UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1202 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1203 | Scheme_Object *expr = NULL; |
| 1204 | Scheme_Object *result = NULL; |
| 1205 | char *file = NULL; |
| 1206 | Port_Info *pinfo = (Port_Info *)data; |
| 1207 | |
| 1208 | MZ_GC_DECL_REG(3); |
| 1209 | MZ_GC_VAR_IN_REG(0, expr); |
| 1210 | MZ_GC_VAR_IN_REG(1, result); |
| 1211 | MZ_GC_VAR_IN_REG(2, file); |
| 1212 | MZ_GC_REG(); |
| 1213 | |
| 1214 | file = (char *)scheme_malloc_fail_ok(scheme_malloc_atomic, MAXPATHL + 1); |
| 1215 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1216 | |
| 1217 | /* make Vim expansion */ |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1218 | expand_env((char_u *)pinfo->name, (char_u *)file, MAXPATHL); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1219 | pinfo->port = scheme_open_input_file(file, "mzfile"); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1220 | MZ_GC_CHECK(); |
| 1221 | scheme_count_lines(pinfo->port); /* to get accurate read error location*/ |
| 1222 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1223 | |
| 1224 | /* Like REPL but print only last result */ |
| 1225 | while (!SCHEME_EOFP(expr = scheme_read(pinfo->port))) |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1226 | { |
| 1227 | result = scheme_eval(expr, environment); |
| 1228 | MZ_GC_CHECK(); |
| 1229 | } |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1230 | |
Bram Moolenaar | 0a1c0ec | 2009-12-16 18:02:47 +0000 | [diff] [blame] | 1231 | /* errors will be caught in do_mzscheme_command and ex_mzfile */ |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1232 | scheme_close_input_port(pinfo->port); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1233 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1234 | pinfo->port = NULL; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1235 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1236 | return result; |
| 1237 | } |
| 1238 | |
| 1239 | /* :mzfile */ |
| 1240 | void |
| 1241 | ex_mzfile(exarg_T *eap) |
| 1242 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1243 | Port_Info pinfo = {NULL, NULL}; |
| 1244 | |
| 1245 | MZ_GC_DECL_REG(1); |
| 1246 | MZ_GC_VAR_IN_REG(0, pinfo.port); |
| 1247 | MZ_GC_REG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1248 | |
| 1249 | pinfo.name = (char *)eap->arg; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1250 | if (do_mzscheme_command(eap, &pinfo, do_load) != OK |
| 1251 | && pinfo.port != NULL) /* looks like port was not closed */ |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1252 | { |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1253 | scheme_close_input_port(pinfo.port); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1254 | MZ_GC_CHECK(); |
| 1255 | } |
| 1256 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1257 | } |
| 1258 | |
| 1259 | |
| 1260 | /* |
| 1261 | *======================================================================== |
| 1262 | * Exception handling code -- cribbed form the MzScheme sources and |
| 1263 | * Matthew Flatt's "Inside PLT MzScheme" document. |
| 1264 | *======================================================================== |
| 1265 | */ |
| 1266 | static void |
| 1267 | init_exn_catching_apply(void) |
| 1268 | { |
| 1269 | if (!exn_catching_apply) |
| 1270 | { |
| 1271 | char *e = |
| 1272 | "(lambda (thunk) " |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1273 | "(with-handlers ([void (lambda (exn) (cons #f exn))]) " |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1274 | "(cons #t (thunk))))"; |
| 1275 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1276 | exn_catching_apply = scheme_eval_string(e, environment); |
| 1277 | MZ_GC_CHECK(); |
| 1278 | exn_p = scheme_builtin_value("exn?"); |
| 1279 | MZ_GC_CHECK(); |
| 1280 | exn_message = scheme_builtin_value("exn-message"); |
| 1281 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1282 | } |
| 1283 | } |
| 1284 | |
| 1285 | /* |
| 1286 | * This function applies a thunk, returning the Scheme value if there's |
| 1287 | * no exception, otherwise returning NULL and setting *exn to the raised |
| 1288 | * value (usually an exn structure). |
| 1289 | */ |
| 1290 | static Scheme_Object * |
| 1291 | _apply_thunk_catch_exceptions(Scheme_Object *f, Scheme_Object **exn) |
| 1292 | { |
| 1293 | Scheme_Object *v; |
| 1294 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1295 | v = _scheme_apply(exn_catching_apply, 1, &f); |
| 1296 | /* v is a pair: (cons #t value) or (cons #f exn) */ |
| 1297 | |
| 1298 | if (SCHEME_TRUEP(SCHEME_CAR(v))) |
| 1299 | return SCHEME_CDR(v); |
| 1300 | else |
| 1301 | { |
| 1302 | *exn = SCHEME_CDR(v); |
| 1303 | return NULL; |
| 1304 | } |
| 1305 | } |
| 1306 | |
| 1307 | static Scheme_Object * |
| 1308 | extract_exn_message(Scheme_Object *v) |
| 1309 | { |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1310 | if (SCHEME_TRUEP(_scheme_apply(exn_p, 1, &v))) |
| 1311 | return _scheme_apply(exn_message, 1, &v); |
| 1312 | else |
| 1313 | return NULL; /* Not an exn structure */ |
| 1314 | } |
| 1315 | |
| 1316 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1317 | do_eval(void *s, int noargc UNUSED, Scheme_Object **noargv UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1318 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1319 | return scheme_eval_string_all((char *)s, environment, TRUE); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1320 | } |
| 1321 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1322 | /* |
| 1323 | *======================================================================== |
| 1324 | * 3. MzScheme I/O Handlers |
| 1325 | *======================================================================== |
| 1326 | */ |
| 1327 | static void |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1328 | do_intrnl_output(char *mesg, int error) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1329 | { |
| 1330 | char *p, *prev; |
| 1331 | |
| 1332 | prev = mesg; |
| 1333 | p = strchr(prev, '\n'); |
| 1334 | while (p) |
| 1335 | { |
| 1336 | *p = '\0'; |
| 1337 | if (error) |
| 1338 | EMSG(prev); |
| 1339 | else |
| 1340 | MSG(prev); |
| 1341 | prev = p + 1; |
| 1342 | p = strchr(prev, '\n'); |
| 1343 | } |
| 1344 | |
| 1345 | if (error) |
| 1346 | EMSG(prev); |
| 1347 | else |
| 1348 | MSG(prev); |
| 1349 | } |
| 1350 | |
| 1351 | static void |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1352 | do_output(char *mesg, long len UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1353 | { |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1354 | do_intrnl_output(mesg, 0); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1355 | } |
| 1356 | |
| 1357 | static void |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1358 | do_err_output(char *mesg) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1359 | { |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1360 | do_intrnl_output(mesg, 1); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1361 | } |
| 1362 | |
| 1363 | static void |
| 1364 | do_printf(char *format, ...) |
| 1365 | { |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1366 | do_intrnl_output(format, 1); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1367 | } |
| 1368 | |
| 1369 | static void |
| 1370 | do_flush(void) |
| 1371 | { |
| 1372 | char *buff; |
| 1373 | long length; |
| 1374 | |
| 1375 | buff = scheme_get_sized_string_output(curerr, &length); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1376 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1377 | if (length) |
| 1378 | { |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1379 | do_err_output(buff); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1380 | return; |
| 1381 | } |
| 1382 | |
| 1383 | buff = scheme_get_sized_string_output(curout, &length); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1384 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1385 | if (length) |
| 1386 | do_output(buff, length); |
| 1387 | } |
| 1388 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1389 | /* |
| 1390 | *======================================================================== |
| 1391 | * 4. Implementation of the Vim Features for MzScheme |
| 1392 | *======================================================================== |
| 1393 | */ |
| 1394 | |
| 1395 | /* (command {command-string}) */ |
| 1396 | static Scheme_Object * |
| 1397 | vim_command(void *data, int argc, Scheme_Object **argv) |
| 1398 | { |
| 1399 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1400 | char *cmd = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); |
| 1401 | |
| 1402 | /* may be use do_cmdline_cmd? */ |
| 1403 | do_cmdline((char_u *)cmd, NULL, NULL, DOCMD_NOWAIT|DOCMD_VERBOSE); |
| 1404 | update_screen(VALID); |
| 1405 | |
| 1406 | raise_if_error(); |
| 1407 | return scheme_void; |
| 1408 | } |
| 1409 | |
| 1410 | /* (eval {expr-string}) */ |
| 1411 | static Scheme_Object * |
| 1412 | vim_eval(void *data, int argc, Scheme_Object **argv) |
| 1413 | { |
| 1414 | #ifdef FEAT_EVAL |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1415 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1416 | char *expr; |
| 1417 | Scheme_Object *result; |
| 1418 | /* hash table to store visited values to avoid infinite loops */ |
| 1419 | Scheme_Hash_Table *visited = NULL; |
| 1420 | typval_T *vim_result; |
| 1421 | |
| 1422 | MZ_GC_DECL_REG(1); |
| 1423 | MZ_GC_VAR_IN_REG(0, visited); |
| 1424 | MZ_GC_REG(); |
| 1425 | |
| 1426 | visited = scheme_make_hash_table(SCHEME_hash_ptr); |
| 1427 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1428 | |
| 1429 | expr = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1430 | vim_result = eval_expr((char_u *)expr, NULL); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1431 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1432 | if (vim_result == NULL) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1433 | raise_vim_exn(_("invalid expression")); |
| 1434 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1435 | result = vim_to_mzscheme(vim_result, 1, visited); |
| 1436 | free_tv(vim_result); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1437 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1438 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1439 | return result; |
| 1440 | #else |
| 1441 | raise_vim_exn(_("expressions disabled at compile time")); |
| 1442 | /* unreachable */ |
| 1443 | return scheme_false; |
| 1444 | #endif |
| 1445 | } |
| 1446 | |
| 1447 | /* (range-start) */ |
| 1448 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1449 | get_range_start(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1450 | { |
| 1451 | return scheme_make_integer(range_start); |
| 1452 | } |
| 1453 | |
| 1454 | /* (range-end) */ |
| 1455 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1456 | get_range_end(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1457 | { |
| 1458 | return scheme_make_integer(range_end); |
| 1459 | } |
| 1460 | |
| 1461 | /* (beep) */ |
| 1462 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1463 | mzscheme_beep(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1464 | { |
| 1465 | vim_beep(); |
| 1466 | return scheme_void; |
| 1467 | } |
| 1468 | |
| 1469 | static Scheme_Object *M_global = NULL; |
| 1470 | |
| 1471 | /* (get-option {option-name}) [buffer/window] */ |
| 1472 | static Scheme_Object * |
| 1473 | get_option(void *data, int argc, Scheme_Object **argv) |
| 1474 | { |
| 1475 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1476 | char_u *name; |
| 1477 | long value; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1478 | char *strval; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1479 | int rc; |
| 1480 | Scheme_Object *rval; |
| 1481 | int opt_flags = 0; |
| 1482 | buf_T *save_curb = curbuf; |
| 1483 | win_T *save_curw = curwin; |
| 1484 | |
| 1485 | name = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); |
| 1486 | |
| 1487 | if (argc > 1) |
| 1488 | { |
| 1489 | if (M_global == NULL) |
| 1490 | { |
| 1491 | MZ_REGISTER_STATIC(M_global); |
| 1492 | M_global = scheme_intern_symbol("global"); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1493 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1494 | } |
| 1495 | |
| 1496 | if (argv[1] == M_global) |
| 1497 | opt_flags = OPT_GLOBAL; |
| 1498 | else if (SCHEME_VIMBUFFERP(argv[1])) |
| 1499 | { |
| 1500 | curbuf = get_valid_buffer(argv[1]); |
| 1501 | opt_flags = OPT_LOCAL; |
| 1502 | } |
| 1503 | else if (SCHEME_VIMWINDOWP(argv[1])) |
| 1504 | { |
| 1505 | win_T *win = get_valid_window(argv[1]); |
| 1506 | |
| 1507 | curwin = win; |
| 1508 | curbuf = win->w_buffer; |
| 1509 | opt_flags = OPT_LOCAL; |
| 1510 | } |
| 1511 | else |
| 1512 | scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv); |
| 1513 | } |
| 1514 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1515 | rc = get_option_value(name, &value, (char_u **)&strval, opt_flags); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1516 | curbuf = save_curb; |
| 1517 | curwin = save_curw; |
| 1518 | |
| 1519 | switch (rc) |
| 1520 | { |
| 1521 | case 1: |
| 1522 | return scheme_make_integer_value(value); |
| 1523 | case 0: |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1524 | rval = scheme_make_string(strval); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1525 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1526 | vim_free(strval); |
| 1527 | return rval; |
| 1528 | case -1: |
| 1529 | case -2: |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1530 | raise_vim_exn(_("hidden option")); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1531 | case -3: |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1532 | raise_vim_exn(_("unknown option")); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1533 | } |
| 1534 | /* unreachable */ |
| 1535 | return scheme_void; |
| 1536 | } |
| 1537 | |
| 1538 | /* (set-option {option-changing-string} [buffer/window]) */ |
| 1539 | static Scheme_Object * |
| 1540 | set_option(void *data, int argc, Scheme_Object **argv) |
| 1541 | { |
| 1542 | char_u *cmd; |
| 1543 | int opt_flags = 0; |
| 1544 | buf_T *save_curb = curbuf; |
| 1545 | win_T *save_curw = curwin; |
| 1546 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1547 | |
| 1548 | GUARANTEE_STRING(prim->name, 0); |
| 1549 | if (argc > 1) |
| 1550 | { |
| 1551 | if (M_global == NULL) |
| 1552 | { |
| 1553 | MZ_REGISTER_STATIC(M_global); |
| 1554 | M_global = scheme_intern_symbol("global"); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1555 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1556 | } |
| 1557 | |
| 1558 | if (argv[1] == M_global) |
| 1559 | opt_flags = OPT_GLOBAL; |
| 1560 | else if (SCHEME_VIMBUFFERP(argv[1])) |
| 1561 | { |
| 1562 | curbuf = get_valid_buffer(argv[1]); |
| 1563 | opt_flags = OPT_LOCAL; |
| 1564 | } |
| 1565 | else if (SCHEME_VIMWINDOWP(argv[1])) |
| 1566 | { |
| 1567 | win_T *win = get_valid_window(argv[1]); |
| 1568 | curwin = win; |
| 1569 | curbuf = win->w_buffer; |
| 1570 | opt_flags = OPT_LOCAL; |
| 1571 | } |
| 1572 | else |
| 1573 | scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv); |
| 1574 | } |
| 1575 | |
| 1576 | /* do_set can modify cmd, make copy */ |
| 1577 | cmd = vim_strsave((char_u *)SCHEME_STR_VAL(argv[0])); |
| 1578 | do_set(cmd, opt_flags); |
| 1579 | vim_free(cmd); |
| 1580 | update_screen(NOT_VALID); |
| 1581 | curbuf = save_curb; |
| 1582 | curwin = save_curw; |
| 1583 | raise_if_error(); |
| 1584 | return scheme_void; |
| 1585 | } |
| 1586 | |
| 1587 | /* |
| 1588 | *=========================================================================== |
| 1589 | * 5. Vim Window-related Manipulation Functions |
| 1590 | *=========================================================================== |
| 1591 | */ |
| 1592 | |
| 1593 | /* (curr-win) */ |
| 1594 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1595 | get_curr_win(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1596 | { |
| 1597 | return (Scheme_Object *)get_vim_curr_window(); |
| 1598 | } |
| 1599 | |
| 1600 | /* (win-count) */ |
| 1601 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1602 | get_window_count(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1603 | { |
| 1604 | win_T *w; |
| 1605 | int n = 0; |
| 1606 | |
Bram Moolenaar | f740b29 | 2006-02-16 22:11:02 +0000 | [diff] [blame] | 1607 | for (w = firstwin; w != NULL; w = w->w_next) |
| 1608 | ++n; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1609 | return scheme_make_integer(n); |
| 1610 | } |
| 1611 | |
| 1612 | /* (get-win-list [buffer]) */ |
| 1613 | static Scheme_Object * |
| 1614 | get_window_list(void *data, int argc, Scheme_Object **argv) |
| 1615 | { |
| 1616 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1617 | vim_mz_buffer *buf; |
| 1618 | Scheme_Object *list; |
| 1619 | win_T *w; |
| 1620 | |
| 1621 | buf = get_buffer_arg(prim->name, 0, argc, argv); |
| 1622 | list = scheme_null; |
| 1623 | |
Bram Moolenaar | f740b29 | 2006-02-16 22:11:02 +0000 | [diff] [blame] | 1624 | for (w = firstwin; w != NULL; w = w->w_next) |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1625 | if (w->w_buffer == buf->buf) |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1626 | { |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1627 | list = scheme_make_pair(window_new(w), list); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1628 | MZ_GC_CHECK(); |
| 1629 | } |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1630 | |
| 1631 | return list; |
| 1632 | } |
| 1633 | |
| 1634 | static Scheme_Object * |
| 1635 | window_new(win_T *win) |
| 1636 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1637 | vim_mz_window *self = NULL; |
| 1638 | |
| 1639 | MZ_GC_DECL_REG(1); |
| 1640 | MZ_GC_VAR_IN_REG(0, self); |
| 1641 | MZ_GC_REG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1642 | |
| 1643 | /* We need to handle deletion of windows underneath us. |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1644 | * If we add a "w_mzscheme_ref" field to the win_T structure, |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1645 | * then we can get at it in win_free() in vim. |
| 1646 | * |
| 1647 | * On a win_free() we set the Scheme object's win_T *field |
| 1648 | * to an invalid value. We trap all uses of a window |
| 1649 | * object, and reject them if the win_T *field is invalid. |
| 1650 | */ |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1651 | if (win->w_mzscheme_ref != NULL) |
| 1652 | return win->w_mzscheme_ref; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1653 | |
| 1654 | self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_window)); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1655 | vim_memset(self, 0, sizeof(vim_mz_window)); |
| 1656 | scheme_dont_gc_ptr(self); /* because win isn't visible to GC */ |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1657 | MZ_GC_CHECK(); |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1658 | win->w_mzscheme_ref = self; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1659 | self->win = win; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1660 | self->so.type = mz_window_type; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1661 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1662 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1663 | return (Scheme_Object *)(self); |
| 1664 | } |
| 1665 | |
| 1666 | /* (get-win-num [window]) */ |
| 1667 | static Scheme_Object * |
| 1668 | get_window_num(void *data, int argc, Scheme_Object **argv) |
| 1669 | { |
| 1670 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1671 | win_T *win = get_window_arg(prim->name, 0, argc, argv)->win; |
| 1672 | int nr = 1; |
| 1673 | win_T *wp; |
| 1674 | |
| 1675 | for (wp = firstwin; wp != win; wp = wp->w_next) |
| 1676 | ++nr; |
| 1677 | |
| 1678 | return scheme_make_integer(nr); |
| 1679 | } |
| 1680 | |
| 1681 | /* (get-win-by-num {windownum}) */ |
| 1682 | static Scheme_Object * |
| 1683 | get_window_by_num(void *data, int argc, Scheme_Object **argv) |
| 1684 | { |
| 1685 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1686 | win_T *win; |
| 1687 | int fnum; |
| 1688 | |
| 1689 | fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0)); |
| 1690 | if (fnum < 1) |
| 1691 | scheme_signal_error(_("window index is out of range")); |
| 1692 | |
Bram Moolenaar | f740b29 | 2006-02-16 22:11:02 +0000 | [diff] [blame] | 1693 | for (win = firstwin; win != NULL; win = win->w_next, --fnum) |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1694 | if (fnum == 1) /* to be 1-based */ |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1695 | return window_new(win); |
| 1696 | |
| 1697 | return scheme_false; |
| 1698 | } |
| 1699 | |
| 1700 | /* (get-win-buffer [window]) */ |
| 1701 | static Scheme_Object * |
| 1702 | get_window_buffer(void *data, int argc, Scheme_Object **argv) |
| 1703 | { |
| 1704 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1705 | vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv); |
| 1706 | |
| 1707 | return buffer_new(win->win->w_buffer); |
| 1708 | } |
| 1709 | |
| 1710 | /* (get-win-height [window]) */ |
| 1711 | static Scheme_Object * |
| 1712 | get_window_height(void *data, int argc, Scheme_Object **argv) |
| 1713 | { |
| 1714 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1715 | vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv); |
| 1716 | |
| 1717 | return scheme_make_integer(win->win->w_height); |
| 1718 | } |
| 1719 | |
| 1720 | /* (set-win-height {height} [window]) */ |
| 1721 | static Scheme_Object * |
| 1722 | set_window_height(void *data, int argc, Scheme_Object **argv) |
| 1723 | { |
| 1724 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1725 | vim_mz_window *win; |
| 1726 | win_T *savewin; |
| 1727 | int height; |
| 1728 | |
| 1729 | win = get_window_arg(prim->name, 1, argc, argv); |
| 1730 | height = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0)); |
| 1731 | |
| 1732 | #ifdef FEAT_GUI |
| 1733 | need_mouse_correct = TRUE; |
| 1734 | #endif |
| 1735 | |
| 1736 | savewin = curwin; |
| 1737 | curwin = win->win; |
| 1738 | win_setheight(height); |
| 1739 | curwin = savewin; |
| 1740 | |
| 1741 | raise_if_error(); |
| 1742 | return scheme_void; |
| 1743 | } |
| 1744 | |
| 1745 | #ifdef FEAT_VERTSPLIT |
| 1746 | /* (get-win-width [window]) */ |
| 1747 | static Scheme_Object * |
| 1748 | get_window_width(void *data, int argc, Scheme_Object **argv) |
| 1749 | { |
| 1750 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1751 | vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv); |
| 1752 | |
| 1753 | return scheme_make_integer(W_WIDTH(win->win)); |
| 1754 | } |
| 1755 | |
| 1756 | /* (set-win-width {width} [window]) */ |
| 1757 | static Scheme_Object * |
| 1758 | set_window_width(void *data, int argc, Scheme_Object **argv) |
| 1759 | { |
| 1760 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1761 | vim_mz_window *win; |
| 1762 | win_T *savewin; |
| 1763 | int width = 0; |
| 1764 | |
| 1765 | win = get_window_arg(prim->name, 1, argc, argv); |
| 1766 | width = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0)); |
| 1767 | |
| 1768 | # ifdef FEAT_GUI |
| 1769 | need_mouse_correct = TRUE; |
| 1770 | # endif |
| 1771 | |
| 1772 | savewin = curwin; |
| 1773 | curwin = win->win; |
| 1774 | win_setwidth(width); |
| 1775 | curwin = savewin; |
| 1776 | |
| 1777 | raise_if_error(); |
| 1778 | return scheme_void; |
| 1779 | } |
| 1780 | #endif |
| 1781 | |
| 1782 | /* (get-cursor [window]) -> (line . col) */ |
| 1783 | static Scheme_Object * |
| 1784 | get_cursor(void *data, int argc, Scheme_Object **argv) |
| 1785 | { |
| 1786 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1787 | vim_mz_window *win; |
| 1788 | pos_T pos; |
| 1789 | |
| 1790 | win = get_window_arg(prim->name, 0, argc, argv); |
| 1791 | pos = win->win->w_cursor; |
| 1792 | return scheme_make_pair(scheme_make_integer_value((long)pos.lnum), |
| 1793 | scheme_make_integer_value((long)pos.col + 1)); |
| 1794 | } |
| 1795 | |
| 1796 | /* (set-cursor (line . col) [window]) */ |
| 1797 | static Scheme_Object * |
| 1798 | set_cursor(void *data, int argc, Scheme_Object **argv) |
| 1799 | { |
| 1800 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1801 | vim_mz_window *win; |
| 1802 | long lnum = 0; |
| 1803 | long col = 0; |
| 1804 | |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 1805 | #ifdef HAVE_SANDBOX |
| 1806 | sandbox_check(); |
| 1807 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1808 | win = get_window_arg(prim->name, 1, argc, argv); |
| 1809 | GUARANTEE_PAIR(prim->name, 0); |
| 1810 | |
| 1811 | if (!SCHEME_INTP(SCHEME_CAR(argv[0])) |
| 1812 | || !SCHEME_INTP(SCHEME_CDR(argv[0]))) |
| 1813 | scheme_wrong_type(prim->name, "integer pair", 0, argc, argv); |
| 1814 | |
| 1815 | lnum = SCHEME_INT_VAL(SCHEME_CAR(argv[0])); |
| 1816 | col = SCHEME_INT_VAL(SCHEME_CDR(argv[0])) - 1; |
| 1817 | |
| 1818 | check_line_range(lnum, win->win->w_buffer); |
| 1819 | /* don't know how to catch invalid column value */ |
| 1820 | |
| 1821 | win->win->w_cursor.lnum = lnum; |
| 1822 | win->win->w_cursor.col = col; |
| 1823 | update_screen(VALID); |
| 1824 | |
| 1825 | raise_if_error(); |
| 1826 | return scheme_void; |
| 1827 | } |
| 1828 | /* |
| 1829 | *=========================================================================== |
| 1830 | * 6. Vim Buffer-related Manipulation Functions |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1831 | *=========================================================================== |
| 1832 | */ |
| 1833 | |
| 1834 | /* (open-buff {filename}) */ |
| 1835 | static Scheme_Object * |
| 1836 | mzscheme_open_buffer(void *data, int argc, Scheme_Object **argv) |
| 1837 | { |
| 1838 | Vim_Prim *prim = (Vim_Prim *)data; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1839 | char_u *fname; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1840 | int num = 0; |
| 1841 | Scheme_Object *onum; |
| 1842 | |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 1843 | #ifdef HAVE_SANDBOX |
| 1844 | sandbox_check(); |
| 1845 | #endif |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1846 | fname = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1847 | /* TODO make open existing file */ |
| 1848 | num = buflist_add(fname, BLN_LISTED | BLN_CURBUF); |
| 1849 | |
| 1850 | if (num == 0) |
| 1851 | raise_vim_exn(_("couldn't open buffer")); |
| 1852 | |
| 1853 | onum = scheme_make_integer(num); |
| 1854 | return get_buffer_by_num(data, 1, &onum); |
| 1855 | } |
| 1856 | |
| 1857 | /* (get-buff-by-num {buffernum}) */ |
| 1858 | static Scheme_Object * |
| 1859 | get_buffer_by_num(void *data, int argc, Scheme_Object **argv) |
| 1860 | { |
| 1861 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1862 | buf_T *buf; |
| 1863 | int fnum; |
| 1864 | |
| 1865 | fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0)); |
| 1866 | |
| 1867 | for (buf = firstbuf; buf; buf = buf->b_next) |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1868 | if (buf->b_fnum == fnum) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1869 | return buffer_new(buf); |
| 1870 | |
| 1871 | return scheme_false; |
| 1872 | } |
| 1873 | |
| 1874 | /* (get-buff-by-name {buffername}) */ |
| 1875 | static Scheme_Object * |
| 1876 | get_buffer_by_name(void *data, int argc, Scheme_Object **argv) |
| 1877 | { |
| 1878 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1879 | buf_T *buf; |
| 1880 | char_u *fname; |
| 1881 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1882 | fname = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1883 | |
| 1884 | for (buf = firstbuf; buf; buf = buf->b_next) |
| 1885 | if (buf->b_ffname == NULL || buf->b_sfname == NULL) |
| 1886 | /* empty string */ |
| 1887 | { |
| 1888 | if (fname[0] == NUL) |
| 1889 | return buffer_new(buf); |
| 1890 | } |
| 1891 | else if (!fnamecmp(buf->b_ffname, fname) |
| 1892 | || !fnamecmp(buf->b_sfname, fname)) |
| 1893 | /* either short or long filename matches */ |
| 1894 | return buffer_new(buf); |
| 1895 | |
| 1896 | return scheme_false; |
| 1897 | } |
| 1898 | |
| 1899 | /* (get-next-buff [buffer]) */ |
| 1900 | static Scheme_Object * |
| 1901 | get_next_buffer(void *data, int argc, Scheme_Object **argv) |
| 1902 | { |
| 1903 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1904 | buf_T *buf = get_buffer_arg(prim->name, 0, argc, argv)->buf; |
| 1905 | |
| 1906 | if (buf->b_next == NULL) |
| 1907 | return scheme_false; |
| 1908 | else |
| 1909 | return buffer_new(buf->b_next); |
| 1910 | } |
| 1911 | |
| 1912 | /* (get-prev-buff [buffer]) */ |
| 1913 | static Scheme_Object * |
| 1914 | get_prev_buffer(void *data, int argc, Scheme_Object **argv) |
| 1915 | { |
| 1916 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1917 | buf_T *buf = get_buffer_arg(prim->name, 0, argc, argv)->buf; |
| 1918 | |
| 1919 | if (buf->b_prev == NULL) |
| 1920 | return scheme_false; |
| 1921 | else |
| 1922 | return buffer_new(buf->b_prev); |
| 1923 | } |
| 1924 | |
| 1925 | /* (get-buff-num [buffer]) */ |
| 1926 | static Scheme_Object * |
| 1927 | get_buffer_num(void *data, int argc, Scheme_Object **argv) |
| 1928 | { |
| 1929 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1930 | vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv); |
| 1931 | |
| 1932 | return scheme_make_integer(buf->buf->b_fnum); |
| 1933 | } |
| 1934 | |
| 1935 | /* (buff-count) */ |
| 1936 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1937 | get_buffer_count(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1938 | { |
| 1939 | buf_T *b; |
| 1940 | int n = 0; |
| 1941 | |
| 1942 | for (b = firstbuf; b; b = b->b_next) ++n; |
| 1943 | return scheme_make_integer(n); |
| 1944 | } |
| 1945 | |
| 1946 | /* (get-buff-name [buffer]) */ |
| 1947 | static Scheme_Object * |
| 1948 | get_buffer_name(void *data, int argc, Scheme_Object **argv) |
| 1949 | { |
| 1950 | Vim_Prim *prim = (Vim_Prim *)data; |
| 1951 | vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv); |
| 1952 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1953 | return scheme_make_string((char *)buf->buf->b_ffname); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1954 | } |
| 1955 | |
| 1956 | /* (curr-buff) */ |
| 1957 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 1958 | get_curr_buffer(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1959 | { |
| 1960 | return (Scheme_Object *)get_vim_curr_buffer(); |
| 1961 | } |
| 1962 | |
| 1963 | static Scheme_Object * |
| 1964 | buffer_new(buf_T *buf) |
| 1965 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1966 | vim_mz_buffer *self = NULL; |
| 1967 | |
| 1968 | MZ_GC_DECL_REG(1); |
| 1969 | MZ_GC_VAR_IN_REG(0, self); |
| 1970 | MZ_GC_REG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1971 | |
| 1972 | /* We need to handle deletion of buffers underneath us. |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1973 | * If we add a "b_mzscheme_ref" field to the buf_T structure, |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1974 | * then we can get at it in buf_freeall() in vim. |
| 1975 | */ |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1976 | if (buf->b_mzscheme_ref) |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 1977 | return buf->b_mzscheme_ref; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1978 | |
| 1979 | self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_buffer)); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1980 | vim_memset(self, 0, sizeof(vim_mz_buffer)); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1981 | scheme_dont_gc_ptr(self); /* because buf isn't visible to GC */ |
| 1982 | MZ_GC_CHECK(); |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 1983 | buf->b_mzscheme_ref = self; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1984 | self->buf = buf; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1985 | self->so.type = mz_buffer_type; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1986 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 1987 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 1988 | return (Scheme_Object *)(self); |
| 1989 | } |
| 1990 | |
| 1991 | /* |
| 1992 | * (get-buff-size [buffer]) |
| 1993 | * |
| 1994 | * Get the size (number of lines) in the current buffer. |
| 1995 | */ |
| 1996 | static Scheme_Object * |
| 1997 | get_buffer_size(void *data, int argc, Scheme_Object **argv) |
| 1998 | { |
| 1999 | Vim_Prim *prim = (Vim_Prim *)data; |
| 2000 | vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv); |
| 2001 | |
| 2002 | return scheme_make_integer(buf->buf->b_ml.ml_line_count); |
| 2003 | } |
| 2004 | |
| 2005 | /* |
| 2006 | * (get-buff-line {linenr} [buffer]) |
| 2007 | * |
| 2008 | * Get a line from the specified buffer. The line number is |
| 2009 | * in Vim format (1-based). The line is returned as a MzScheme |
| 2010 | * string object. |
| 2011 | */ |
| 2012 | static Scheme_Object * |
| 2013 | get_buffer_line(void *data, int argc, Scheme_Object **argv) |
| 2014 | { |
| 2015 | Vim_Prim *prim = (Vim_Prim *)data; |
| 2016 | vim_mz_buffer *buf; |
| 2017 | int linenr; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2018 | char_u *line; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2019 | |
| 2020 | buf = get_buffer_arg(prim->name, 1, argc, argv); |
| 2021 | linenr = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0)); |
| 2022 | line = ml_get_buf(buf->buf, (linenr_T)linenr, FALSE); |
| 2023 | |
| 2024 | raise_if_error(); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2025 | return scheme_make_string((char *)line); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2026 | } |
| 2027 | |
| 2028 | |
| 2029 | /* |
| 2030 | * (get-buff-line-list {start} {end} [buffer]) |
| 2031 | * |
| 2032 | * Get a list of lines from the specified buffer. The line numbers |
| 2033 | * are in Vim format (1-based). The range is from lo up to, but not |
| 2034 | * including, hi. The list is returned as a list of string objects. |
| 2035 | */ |
| 2036 | static Scheme_Object * |
| 2037 | get_buffer_line_list(void *data, int argc, Scheme_Object **argv) |
| 2038 | { |
| 2039 | Vim_Prim *prim = (Vim_Prim *)data; |
| 2040 | vim_mz_buffer *buf; |
| 2041 | int i, hi, lo, n; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2042 | Scheme_Object *list = NULL; |
| 2043 | |
| 2044 | MZ_GC_DECL_REG(1); |
| 2045 | MZ_GC_VAR_IN_REG(0, list); |
| 2046 | MZ_GC_REG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2047 | |
| 2048 | buf = get_buffer_arg(prim->name, 2, argc, argv); |
| 2049 | list = scheme_null; |
| 2050 | hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1)); |
| 2051 | lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0)); |
| 2052 | |
| 2053 | /* |
| 2054 | * Handle some error conditions |
| 2055 | */ |
| 2056 | if (lo < 0) |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 2057 | lo = 0; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2058 | |
| 2059 | if (hi < 0) |
| 2060 | hi = 0; |
| 2061 | if (hi < lo) |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 2062 | hi = lo; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2063 | |
| 2064 | n = hi - lo; |
| 2065 | |
| 2066 | for (i = n; i >= 0; --i) |
| 2067 | { |
| 2068 | Scheme_Object *str = scheme_make_string( |
| 2069 | (char *)ml_get_buf(buf->buf, (linenr_T)(lo+i), FALSE)); |
| 2070 | raise_if_error(); |
| 2071 | |
| 2072 | /* Set the list item */ |
| 2073 | list = scheme_make_pair(str, list); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2074 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2075 | } |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2076 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2077 | return list; |
| 2078 | } |
| 2079 | |
| 2080 | /* |
| 2081 | * (set-buff-line {linenr} {string/#f} [buffer]) |
| 2082 | * |
| 2083 | * Replace a line in the specified buffer. The line number is |
| 2084 | * in Vim format (1-based). The replacement line is given as |
| 2085 | * an MzScheme string object. The object is checked for validity |
| 2086 | * and correct format. An exception is thrown if the values are not |
| 2087 | * the correct format. |
| 2088 | * |
| 2089 | * It returns a Scheme Object that indicates the length of the |
| 2090 | * string changed. |
| 2091 | */ |
| 2092 | static Scheme_Object * |
| 2093 | set_buffer_line(void *data, int argc, Scheme_Object **argv) |
| 2094 | { |
Bram Moolenaar | 0a1c0ec | 2009-12-16 18:02:47 +0000 | [diff] [blame] | 2095 | /* First of all, we check the value of the supplied MzScheme object. |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2096 | * There are three cases: |
| 2097 | * 1. #f - this is a deletion. |
| 2098 | * 2. A string - this is a replacement. |
| 2099 | * 3. Anything else - this is an error. |
| 2100 | */ |
| 2101 | Vim_Prim *prim = (Vim_Prim *)data; |
| 2102 | vim_mz_buffer *buf; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2103 | Scheme_Object *line = NULL; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2104 | char *save; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2105 | int n; |
| 2106 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2107 | MZ_GC_DECL_REG(1); |
| 2108 | MZ_GC_VAR_IN_REG(0, line); |
| 2109 | MZ_GC_REG(); |
| 2110 | |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 2111 | #ifdef HAVE_SANDBOX |
| 2112 | sandbox_check(); |
| 2113 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2114 | n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0)); |
| 2115 | if (!SCHEME_STRINGP(argv[1]) && !SCHEME_FALSEP(argv[1])) |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 2116 | scheme_wrong_type(prim->name, "string or #f", 1, argc, argv); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2117 | line = argv[1]; |
| 2118 | buf = get_buffer_arg(prim->name, 2, argc, argv); |
| 2119 | |
| 2120 | check_line_range(n, buf->buf); |
| 2121 | |
| 2122 | if (SCHEME_FALSEP(line)) |
| 2123 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2124 | buf_T *savebuf = curbuf; |
| 2125 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2126 | curbuf = buf->buf; |
| 2127 | |
| 2128 | if (u_savedel((linenr_T)n, 1L) == FAIL) |
| 2129 | { |
| 2130 | curbuf = savebuf; |
| 2131 | raise_vim_exn(_("cannot save undo information")); |
| 2132 | } |
| 2133 | else if (ml_delete((linenr_T)n, FALSE) == FAIL) |
| 2134 | { |
| 2135 | curbuf = savebuf; |
| 2136 | raise_vim_exn(_("cannot delete line")); |
| 2137 | } |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2138 | if (buf->buf == curwin->w_buffer) |
| 2139 | mz_fix_cursor(n, n + 1, -1); |
Bram Moolenaar | cdcaa58 | 2009-07-09 18:06:49 +0000 | [diff] [blame] | 2140 | deleted_lines_mark((linenr_T)n, 1L); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2141 | |
| 2142 | curbuf = savebuf; |
| 2143 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2144 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2145 | raise_if_error(); |
| 2146 | return scheme_void; |
| 2147 | } |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2148 | else |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2149 | { |
| 2150 | /* Otherwise it's a line */ |
| 2151 | buf_T *savebuf = curbuf; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2152 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2153 | save = string_to_line(line); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2154 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2155 | curbuf = buf->buf; |
| 2156 | |
| 2157 | if (u_savesub((linenr_T)n) == FAIL) |
| 2158 | { |
| 2159 | curbuf = savebuf; |
| 2160 | vim_free(save); |
| 2161 | raise_vim_exn(_("cannot save undo information")); |
| 2162 | } |
| 2163 | else if (ml_replace((linenr_T)n, (char_u *)save, TRUE) == FAIL) |
| 2164 | { |
| 2165 | curbuf = savebuf; |
| 2166 | vim_free(save); |
| 2167 | raise_vim_exn(_("cannot replace line")); |
| 2168 | } |
| 2169 | else |
| 2170 | { |
| 2171 | vim_free(save); |
| 2172 | changed_bytes((linenr_T)n, 0); |
| 2173 | } |
| 2174 | |
| 2175 | curbuf = savebuf; |
| 2176 | |
| 2177 | /* Check that the cursor is not beyond the end of the line now. */ |
| 2178 | if (buf->buf == curwin->w_buffer) |
| 2179 | check_cursor_col(); |
| 2180 | |
| 2181 | MZ_GC_UNREG(); |
| 2182 | raise_if_error(); |
| 2183 | return scheme_void; |
| 2184 | } |
| 2185 | } |
| 2186 | |
| 2187 | static void |
| 2188 | free_array(char **array) |
| 2189 | { |
| 2190 | char **curr = array; |
| 2191 | while (*curr != NULL) |
| 2192 | vim_free(*curr++); |
| 2193 | vim_free(array); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2194 | } |
| 2195 | |
| 2196 | /* |
| 2197 | * (set-buff-line-list {start} {end} {string-list/#f/null} [buffer]) |
| 2198 | * |
| 2199 | * Replace a range of lines in the specified buffer. The line numbers are in |
| 2200 | * Vim format (1-based). The range is from lo up to, but not including, hi. |
| 2201 | * The replacement lines are given as a Scheme list of string objects. The |
| 2202 | * list is checked for validity and correct format. |
| 2203 | * |
| 2204 | * Errors are returned as a value of FAIL. The return value is OK on success. |
| 2205 | * If OK is returned and len_change is not NULL, *len_change is set to the |
| 2206 | * change in the buffer length. |
| 2207 | */ |
| 2208 | static Scheme_Object * |
| 2209 | set_buffer_line_list(void *data, int argc, Scheme_Object **argv) |
| 2210 | { |
| 2211 | /* First of all, we check the type of the supplied MzScheme object. |
| 2212 | * There are three cases: |
| 2213 | * 1. #f - this is a deletion. |
| 2214 | * 2. A list - this is a replacement. |
| 2215 | * 3. Anything else - this is an error. |
| 2216 | */ |
| 2217 | Vim_Prim *prim = (Vim_Prim *)data; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2218 | vim_mz_buffer *buf = NULL; |
| 2219 | Scheme_Object *line_list = NULL; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2220 | int i, old_len, new_len, hi, lo; |
| 2221 | long extra; |
| 2222 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2223 | MZ_GC_DECL_REG(1); |
| 2224 | MZ_GC_VAR_IN_REG(0, line_list); |
| 2225 | MZ_GC_REG(); |
| 2226 | |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 2227 | #ifdef HAVE_SANDBOX |
| 2228 | sandbox_check(); |
| 2229 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2230 | lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0)); |
| 2231 | hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1)); |
| 2232 | if (!SCHEME_PAIRP(argv[2]) |
| 2233 | && !SCHEME_FALSEP(argv[2]) && !SCHEME_NULLP(argv[2])) |
| 2234 | scheme_wrong_type(prim->name, "list or #f", 2, argc, argv); |
| 2235 | line_list = argv[2]; |
| 2236 | buf = get_buffer_arg(prim->name, 3, argc, argv); |
| 2237 | old_len = hi - lo; |
| 2238 | if (old_len < 0) /* process inverse values wisely */ |
| 2239 | { |
| 2240 | i = lo; |
| 2241 | lo = hi; |
| 2242 | hi = i; |
| 2243 | old_len = -old_len; |
| 2244 | } |
| 2245 | extra = 0; |
| 2246 | |
| 2247 | check_line_range(lo, buf->buf); /* inclusive */ |
Bram Moolenaar | bae0c16 | 2007-05-10 19:30:25 +0000 | [diff] [blame] | 2248 | check_line_range(hi - 1, buf->buf); /* exclusive */ |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2249 | |
| 2250 | if (SCHEME_FALSEP(line_list) || SCHEME_NULLP(line_list)) |
| 2251 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2252 | buf_T *savebuf = curbuf; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2253 | curbuf = buf->buf; |
| 2254 | |
| 2255 | if (u_savedel((linenr_T)lo, (long)old_len) == FAIL) |
| 2256 | { |
| 2257 | curbuf = savebuf; |
| 2258 | raise_vim_exn(_("cannot save undo information")); |
| 2259 | } |
| 2260 | else |
| 2261 | { |
| 2262 | for (i = 0; i < old_len; i++) |
| 2263 | if (ml_delete((linenr_T)lo, FALSE) == FAIL) |
| 2264 | { |
| 2265 | curbuf = savebuf; |
| 2266 | raise_vim_exn(_("cannot delete line")); |
| 2267 | } |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2268 | if (buf->buf == curwin->w_buffer) |
| 2269 | mz_fix_cursor(lo, hi, -old_len); |
Bram Moolenaar | cdcaa58 | 2009-07-09 18:06:49 +0000 | [diff] [blame] | 2270 | deleted_lines_mark((linenr_T)lo, (long)old_len); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2271 | } |
| 2272 | |
| 2273 | curbuf = savebuf; |
| 2274 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2275 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2276 | raise_if_error(); |
| 2277 | return scheme_void; |
| 2278 | } |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2279 | else |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2280 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2281 | buf_T *savebuf = curbuf; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2282 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2283 | /* List */ |
| 2284 | new_len = scheme_proper_list_length(line_list); |
| 2285 | MZ_GC_CHECK(); |
| 2286 | if (new_len < 0) /* improper or cyclic list */ |
| 2287 | scheme_wrong_type(prim->name, "proper list", |
| 2288 | 2, argc, argv); |
| 2289 | else |
| 2290 | { |
| 2291 | char **array = NULL; |
| 2292 | Scheme_Object *line = NULL; |
| 2293 | Scheme_Object *rest = NULL; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2294 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2295 | MZ_GC_DECL_REG(2); |
| 2296 | MZ_GC_VAR_IN_REG(0, line); |
| 2297 | MZ_GC_VAR_IN_REG(1, rest); |
| 2298 | MZ_GC_REG(); |
| 2299 | |
| 2300 | array = (char **)alloc(new_len * sizeof(char *)); |
| 2301 | vim_memset(array, 0, new_len * sizeof(char *)); |
| 2302 | |
| 2303 | rest = line_list; |
| 2304 | for (i = 0; i < new_len; ++i) |
| 2305 | { |
| 2306 | line = SCHEME_CAR(rest); |
| 2307 | rest = SCHEME_CDR(rest); |
| 2308 | if (!SCHEME_STRINGP(line)) |
| 2309 | { |
| 2310 | free_array(array); |
| 2311 | scheme_wrong_type(prim->name, "string-list", 2, argc, argv); |
| 2312 | } |
| 2313 | array[i] = string_to_line(line); |
| 2314 | } |
| 2315 | |
| 2316 | curbuf = buf->buf; |
| 2317 | |
| 2318 | if (u_save((linenr_T)(lo-1), (linenr_T)hi) == FAIL) |
| 2319 | { |
| 2320 | curbuf = savebuf; |
| 2321 | free_array(array); |
| 2322 | raise_vim_exn(_("cannot save undo information")); |
| 2323 | } |
| 2324 | |
| 2325 | /* |
| 2326 | * If the size of the range is reducing (ie, new_len < old_len) we |
| 2327 | * need to delete some old_len. We do this at the start, by |
| 2328 | * repeatedly deleting line "lo". |
| 2329 | */ |
| 2330 | for (i = 0; i < old_len - new_len; ++i) |
| 2331 | { |
| 2332 | if (ml_delete((linenr_T)lo, FALSE) == FAIL) |
| 2333 | { |
| 2334 | curbuf = savebuf; |
| 2335 | free_array(array); |
| 2336 | raise_vim_exn(_("cannot delete line")); |
| 2337 | } |
| 2338 | extra--; |
| 2339 | } |
| 2340 | |
| 2341 | /* |
| 2342 | * For as long as possible, replace the existing old_len with the |
| 2343 | * new old_len. This is a more efficient operation, as it requires |
| 2344 | * less memory allocation and freeing. |
| 2345 | */ |
| 2346 | for (i = 0; i < old_len && i < new_len; i++) |
| 2347 | if (ml_replace((linenr_T)(lo+i), (char_u *)array[i], TRUE) == FAIL) |
| 2348 | { |
| 2349 | curbuf = savebuf; |
| 2350 | free_array(array); |
| 2351 | raise_vim_exn(_("cannot replace line")); |
| 2352 | } |
| 2353 | |
| 2354 | /* |
| 2355 | * Now we may need to insert the remaining new_len. We don't need to |
| 2356 | * free the string passed back because MzScheme has control of that |
| 2357 | * memory. |
| 2358 | */ |
| 2359 | while (i < new_len) |
| 2360 | { |
| 2361 | if (ml_append((linenr_T)(lo + i - 1), |
| 2362 | (char_u *)array[i], 0, FALSE) == FAIL) |
| 2363 | { |
| 2364 | curbuf = savebuf; |
| 2365 | free_array(array); |
| 2366 | raise_vim_exn(_("cannot insert line")); |
| 2367 | } |
| 2368 | ++i; |
| 2369 | ++extra; |
| 2370 | } |
| 2371 | MZ_GC_UNREG(); |
| 2372 | free_array(array); |
| 2373 | } |
| 2374 | |
| 2375 | /* |
| 2376 | * Adjust marks. Invalidate any which lie in the |
| 2377 | * changed range, and move any in the remainder of the buffer. |
| 2378 | */ |
| 2379 | mark_adjust((linenr_T)lo, (linenr_T)(hi - 1), (long)MAXLNUM, (long)extra); |
| 2380 | changed_lines((linenr_T)lo, 0, (linenr_T)hi, (long)extra); |
| 2381 | |
| 2382 | if (buf->buf == curwin->w_buffer) |
| 2383 | mz_fix_cursor(lo, hi, extra); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2384 | curbuf = savebuf; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2385 | |
| 2386 | MZ_GC_UNREG(); |
| 2387 | raise_if_error(); |
| 2388 | return scheme_void; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2389 | } |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2390 | } |
| 2391 | |
| 2392 | /* |
| 2393 | * (insert-buff-line-list {linenr} {string/string-list} [buffer]) |
| 2394 | * |
Bram Moolenaar | 0a1c0ec | 2009-12-16 18:02:47 +0000 | [diff] [blame] | 2395 | * Insert a number of lines into the specified buffer after the specified line. |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2396 | * The line number is in Vim format (1-based). The lines to be inserted are |
| 2397 | * given as an MzScheme list of string objects or as a single string. The lines |
| 2398 | * to be added are checked for validity and correct format. Errors are |
| 2399 | * returned as a value of FAIL. The return value is OK on success. |
| 2400 | * If OK is returned and len_change is not NULL, *len_change |
| 2401 | * is set to the change in the buffer length. |
| 2402 | */ |
| 2403 | static Scheme_Object * |
| 2404 | insert_buffer_line_list(void *data, int argc, Scheme_Object **argv) |
| 2405 | { |
| 2406 | Vim_Prim *prim = (Vim_Prim *)data; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2407 | vim_mz_buffer *buf = NULL; |
| 2408 | Scheme_Object *list = NULL; |
| 2409 | char *str = NULL; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2410 | int i, n, size; |
| 2411 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2412 | MZ_GC_DECL_REG(1); |
| 2413 | MZ_GC_VAR_IN_REG(0, list); |
| 2414 | MZ_GC_REG(); |
| 2415 | |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 2416 | #ifdef HAVE_SANDBOX |
| 2417 | sandbox_check(); |
| 2418 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2419 | /* |
| 2420 | * First of all, we check the type of the supplied MzScheme object. |
| 2421 | * It must be a string or a list, or the call is in error. |
| 2422 | */ |
| 2423 | n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0)); |
| 2424 | list = argv[1]; |
| 2425 | |
| 2426 | if (!SCHEME_STRINGP(list) && !SCHEME_PAIRP(list)) |
| 2427 | scheme_wrong_type(prim->name, "string or list", 1, argc, argv); |
| 2428 | buf = get_buffer_arg(prim->name, 2, argc, argv); |
| 2429 | |
| 2430 | if (n != 0) /* 0 can be used in insert */ |
Bram Moolenaar | c9b4b05 | 2006-04-30 18:54:39 +0000 | [diff] [blame] | 2431 | check_line_range(n, buf->buf); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2432 | if (SCHEME_STRINGP(list)) |
| 2433 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2434 | buf_T *savebuf = curbuf; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2435 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2436 | str = string_to_line(list); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2437 | curbuf = buf->buf; |
| 2438 | |
| 2439 | if (u_save((linenr_T)n, (linenr_T)(n+1)) == FAIL) |
| 2440 | { |
| 2441 | curbuf = savebuf; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2442 | vim_free(str); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2443 | raise_vim_exn(_("cannot save undo information")); |
| 2444 | } |
| 2445 | else if (ml_append((linenr_T)n, (char_u *)str, 0, FALSE) == FAIL) |
| 2446 | { |
| 2447 | curbuf = savebuf; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2448 | vim_free(str); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2449 | raise_vim_exn(_("cannot insert line")); |
| 2450 | } |
| 2451 | else |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2452 | { |
| 2453 | vim_free(str); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2454 | appended_lines_mark((linenr_T)n, 1L); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2455 | } |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2456 | |
| 2457 | curbuf = savebuf; |
| 2458 | update_screen(VALID); |
| 2459 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2460 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2461 | raise_if_error(); |
| 2462 | return scheme_void; |
| 2463 | } |
| 2464 | |
| 2465 | /* List */ |
| 2466 | size = scheme_proper_list_length(list); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2467 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2468 | if (size < 0) /* improper or cyclic list */ |
| 2469 | scheme_wrong_type(prim->name, "proper list", |
| 2470 | 2, argc, argv); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2471 | else |
| 2472 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2473 | Scheme_Object *line = NULL; |
| 2474 | Scheme_Object *rest = NULL; |
| 2475 | char **array; |
| 2476 | buf_T *savebuf = curbuf; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2477 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2478 | MZ_GC_DECL_REG(2); |
| 2479 | MZ_GC_VAR_IN_REG(0, line); |
| 2480 | MZ_GC_VAR_IN_REG(1, rest); |
| 2481 | MZ_GC_REG(); |
| 2482 | |
| 2483 | array = (char **)alloc(size * sizeof(char *)); |
| 2484 | vim_memset(array, 0, size * sizeof(char *)); |
| 2485 | |
| 2486 | rest = list; |
| 2487 | for (i = 0; i < size; ++i) |
| 2488 | { |
| 2489 | line = SCHEME_CAR(rest); |
| 2490 | rest = SCHEME_CDR(rest); |
| 2491 | array[i] = string_to_line(line); |
| 2492 | } |
| 2493 | |
| 2494 | curbuf = buf->buf; |
| 2495 | |
| 2496 | if (u_save((linenr_T)n, (linenr_T)(n + 1)) == FAIL) |
| 2497 | { |
| 2498 | curbuf = savebuf; |
| 2499 | free_array(array); |
| 2500 | raise_vim_exn(_("cannot save undo information")); |
| 2501 | } |
| 2502 | else |
| 2503 | { |
| 2504 | for (i = 0; i < size; ++i) |
| 2505 | if (ml_append((linenr_T)(n + i), (char_u *)array[i], |
| 2506 | 0, FALSE) == FAIL) |
| 2507 | { |
| 2508 | curbuf = savebuf; |
| 2509 | free_array(array); |
| 2510 | raise_vim_exn(_("cannot insert line")); |
| 2511 | } |
| 2512 | |
| 2513 | if (i > 0) |
| 2514 | appended_lines_mark((linenr_T)n, (long)i); |
| 2515 | } |
| 2516 | free_array(array); |
| 2517 | MZ_GC_UNREG(); |
| 2518 | curbuf = savebuf; |
| 2519 | update_screen(VALID); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2520 | } |
| 2521 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2522 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2523 | raise_if_error(); |
| 2524 | return scheme_void; |
| 2525 | } |
| 2526 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2527 | /* |
| 2528 | * Predicates |
| 2529 | */ |
| 2530 | /* (buff? obj) */ |
| 2531 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 2532 | vim_bufferp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2533 | { |
| 2534 | if (SCHEME_VIMBUFFERP(argv[0])) |
| 2535 | return scheme_true; |
| 2536 | else |
| 2537 | return scheme_false; |
| 2538 | } |
| 2539 | |
| 2540 | /* (win? obj) */ |
| 2541 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 2542 | vim_windowp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2543 | { |
| 2544 | if (SCHEME_VIMWINDOWP(argv[0])) |
| 2545 | return scheme_true; |
| 2546 | else |
| 2547 | return scheme_false; |
| 2548 | } |
| 2549 | |
| 2550 | /* (buff-valid? obj) */ |
| 2551 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 2552 | vim_buffer_validp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2553 | { |
| 2554 | if (SCHEME_VIMBUFFERP(argv[0]) |
| 2555 | && ((vim_mz_buffer *)argv[0])->buf != INVALID_BUFFER_VALUE) |
| 2556 | return scheme_true; |
| 2557 | else |
| 2558 | return scheme_false; |
| 2559 | } |
| 2560 | |
| 2561 | /* (win-valid? obj) */ |
| 2562 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 2563 | vim_window_validp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2564 | { |
| 2565 | if (SCHEME_VIMWINDOWP(argv[0]) |
| 2566 | && ((vim_mz_window *)argv[0])->win != INVALID_WINDOW_VALUE) |
| 2567 | return scheme_true; |
| 2568 | else |
| 2569 | return scheme_false; |
| 2570 | } |
| 2571 | |
| 2572 | /* |
| 2573 | *=========================================================================== |
| 2574 | * Utilities |
| 2575 | *=========================================================================== |
| 2576 | */ |
| 2577 | |
| 2578 | /* |
| 2579 | * Convert an MzScheme string into a Vim line. |
| 2580 | * |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2581 | * All internal nulls are replaced by newline characters. |
| 2582 | * It is an error for the string to contain newline characters. |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2583 | * |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2584 | * Returns pointer to Vim allocated memory |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2585 | */ |
| 2586 | static char * |
| 2587 | string_to_line(Scheme_Object *obj) |
| 2588 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2589 | char *scheme_str = NULL; |
| 2590 | char *vim_str = NULL; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2591 | long len; |
| 2592 | int i; |
| 2593 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2594 | scheme_str = scheme_display_to_string(obj, &len); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2595 | |
| 2596 | /* Error checking: String must not contain newlines, as we |
| 2597 | * are replacing a single line, and we must replace it with |
| 2598 | * a single line. |
| 2599 | */ |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2600 | if (memchr(scheme_str, '\n', len)) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2601 | scheme_signal_error(_("string cannot contain newlines")); |
| 2602 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2603 | vim_str = (char *)alloc(len + 1); |
| 2604 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2605 | /* Create a copy of the string, with internal nulls replaced by |
| 2606 | * newline characters, as is the vim convention. |
| 2607 | */ |
| 2608 | for (i = 0; i < len; ++i) |
| 2609 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2610 | if (scheme_str[i] == '\0') |
| 2611 | vim_str[i] = '\n'; |
| 2612 | else |
| 2613 | vim_str[i] = scheme_str[i]; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2614 | } |
| 2615 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2616 | vim_str[i] = '\0'; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2617 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2618 | MZ_GC_CHECK(); |
| 2619 | return vim_str; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2620 | } |
| 2621 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2622 | #ifdef FEAT_EVAL |
| 2623 | /* |
| 2624 | * Convert Vim value into MzScheme, adopted from if_python.c |
| 2625 | */ |
| 2626 | static Scheme_Object * |
| 2627 | vim_to_mzscheme(typval_T *vim_value, int depth, Scheme_Hash_Table *visited) |
| 2628 | { |
| 2629 | Scheme_Object *result = NULL; |
| 2630 | int new_value = TRUE; |
| 2631 | |
| 2632 | MZ_GC_DECL_REG(1); |
| 2633 | MZ_GC_VAR_IN_REG(0, result); |
| 2634 | MZ_GC_REG(); |
| 2635 | |
| 2636 | /* Avoid infinite recursion */ |
| 2637 | if (depth > 100) |
| 2638 | { |
| 2639 | MZ_GC_UNREG(); |
| 2640 | return scheme_void; |
| 2641 | } |
| 2642 | |
| 2643 | /* Check if we run into a recursive loop. The item must be in visited |
| 2644 | * then and we can use it again. |
| 2645 | */ |
| 2646 | result = scheme_hash_get(visited, (Scheme_Object *)vim_value); |
| 2647 | MZ_GC_CHECK(); |
| 2648 | if (result != NULL) /* found, do nothing */ |
| 2649 | new_value = FALSE; |
| 2650 | else if (vim_value->v_type == VAR_STRING) |
| 2651 | { |
Bram Moolenaar | d04da7c | 2012-10-14 03:41:59 +0200 | [diff] [blame] | 2652 | result = scheme_make_string(vim_value->vval.v_string == NULL |
| 2653 | ? "" : (char *)vim_value->vval.v_string); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2654 | MZ_GC_CHECK(); |
| 2655 | } |
| 2656 | else if (vim_value->v_type == VAR_NUMBER) |
| 2657 | { |
| 2658 | result = scheme_make_integer((long)vim_value->vval.v_number); |
| 2659 | MZ_GC_CHECK(); |
| 2660 | } |
| 2661 | # ifdef FEAT_FLOAT |
| 2662 | else if (vim_value->v_type == VAR_FLOAT) |
| 2663 | { |
| 2664 | result = scheme_make_double((double)vim_value->vval.v_float); |
| 2665 | MZ_GC_CHECK(); |
| 2666 | } |
| 2667 | # endif |
| 2668 | else if (vim_value->v_type == VAR_LIST) |
| 2669 | { |
| 2670 | list_T *list = vim_value->vval.v_list; |
| 2671 | listitem_T *curr; |
| 2672 | |
| 2673 | if (list == NULL || list->lv_first == NULL) |
| 2674 | result = scheme_null; |
| 2675 | else |
| 2676 | { |
| 2677 | Scheme_Object *obj = NULL; |
| 2678 | |
| 2679 | MZ_GC_DECL_REG(1); |
| 2680 | MZ_GC_VAR_IN_REG(0, obj); |
| 2681 | MZ_GC_REG(); |
| 2682 | |
| 2683 | curr = list->lv_last; |
| 2684 | obj = vim_to_mzscheme(&curr->li_tv, depth + 1, visited); |
| 2685 | result = scheme_make_pair(obj, scheme_null); |
| 2686 | MZ_GC_CHECK(); |
| 2687 | |
| 2688 | while (curr != list->lv_first) |
| 2689 | { |
| 2690 | curr = curr->li_prev; |
| 2691 | obj = vim_to_mzscheme(&curr->li_tv, depth + 1, visited); |
| 2692 | result = scheme_make_pair(obj, result); |
| 2693 | MZ_GC_CHECK(); |
| 2694 | } |
| 2695 | } |
| 2696 | MZ_GC_UNREG(); |
| 2697 | } |
| 2698 | else if (vim_value->v_type == VAR_DICT) |
| 2699 | { |
| 2700 | Scheme_Object *key = NULL; |
| 2701 | Scheme_Object *obj = NULL; |
| 2702 | |
| 2703 | MZ_GC_DECL_REG(2); |
| 2704 | MZ_GC_VAR_IN_REG(0, key); |
| 2705 | MZ_GC_VAR_IN_REG(1, obj); |
| 2706 | MZ_GC_REG(); |
| 2707 | |
| 2708 | result = (Scheme_Object *)scheme_make_hash_table(SCHEME_hash_ptr); |
| 2709 | MZ_GC_CHECK(); |
| 2710 | if (vim_value->vval.v_dict != NULL) |
| 2711 | { |
| 2712 | hashtab_T *ht = &vim_value->vval.v_dict->dv_hashtab; |
| 2713 | long_u todo = ht->ht_used; |
| 2714 | hashitem_T *hi; |
| 2715 | dictitem_T *di; |
| 2716 | |
| 2717 | for (hi = ht->ht_array; todo > 0; ++hi) |
| 2718 | { |
| 2719 | if (!HASHITEM_EMPTY(hi)) |
| 2720 | { |
| 2721 | --todo; |
| 2722 | |
| 2723 | di = dict_lookup(hi); |
| 2724 | obj = vim_to_mzscheme(&di->di_tv, depth + 1, visited); |
| 2725 | key = scheme_make_string((char *)hi->hi_key); |
| 2726 | MZ_GC_CHECK(); |
| 2727 | scheme_hash_set((Scheme_Hash_Table *)result, key, obj); |
| 2728 | MZ_GC_CHECK(); |
| 2729 | } |
| 2730 | } |
| 2731 | } |
| 2732 | MZ_GC_UNREG(); |
| 2733 | } |
| 2734 | else |
| 2735 | { |
| 2736 | result = scheme_void; |
| 2737 | new_value = FALSE; |
| 2738 | } |
| 2739 | if (new_value) |
| 2740 | { |
| 2741 | scheme_hash_set(visited, (Scheme_Object *)vim_value, result); |
| 2742 | MZ_GC_CHECK(); |
| 2743 | } |
| 2744 | MZ_GC_UNREG(); |
| 2745 | return result; |
| 2746 | } |
Bram Moolenaar | 7e506b6 | 2010-01-19 15:55:06 +0100 | [diff] [blame] | 2747 | |
| 2748 | static int |
| 2749 | mzscheme_to_vim(Scheme_Object *obj, typval_T *tv, int depth, |
| 2750 | Scheme_Hash_Table *visited) |
| 2751 | { |
| 2752 | int status = OK; |
| 2753 | typval_T *found; |
| 2754 | MZ_GC_CHECK(); |
| 2755 | if (depth > 100) /* limit the deepest recursion level */ |
| 2756 | { |
| 2757 | tv->v_type = VAR_NUMBER; |
| 2758 | tv->vval.v_number = 0; |
| 2759 | return FAIL; |
| 2760 | } |
| 2761 | |
| 2762 | found = (typval_T *)scheme_hash_get(visited, obj); |
| 2763 | if (found != NULL) |
| 2764 | copy_tv(found, tv); |
| 2765 | else if (SCHEME_VOIDP(obj)) |
| 2766 | { |
| 2767 | tv->v_type = VAR_NUMBER; |
| 2768 | tv->vval.v_number = 0; |
| 2769 | } |
| 2770 | else if (SCHEME_INTP(obj)) |
| 2771 | { |
| 2772 | tv->v_type = VAR_NUMBER; |
| 2773 | tv->vval.v_number = SCHEME_INT_VAL(obj); |
| 2774 | } |
| 2775 | else if (SCHEME_BOOLP(obj)) |
| 2776 | { |
| 2777 | tv->v_type = VAR_NUMBER; |
| 2778 | tv->vval.v_number = SCHEME_TRUEP(obj); |
| 2779 | } |
| 2780 | # ifdef FEAT_FLOAT |
| 2781 | else if (SCHEME_DBLP(obj)) |
| 2782 | { |
| 2783 | tv->v_type = VAR_FLOAT; |
| 2784 | tv->vval.v_float = SCHEME_DBL_VAL(obj); |
| 2785 | } |
| 2786 | # endif |
| 2787 | else if (SCHEME_STRINGP(obj)) |
| 2788 | { |
| 2789 | tv->v_type = VAR_STRING; |
| 2790 | tv->vval.v_string = vim_strsave((char_u *)SCHEME_STR_VAL(obj)); |
| 2791 | } |
| 2792 | else if (SCHEME_VECTORP(obj) || SCHEME_NULLP(obj) |
| 2793 | || SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj)) |
| 2794 | { |
| 2795 | list_T *list = list_alloc(); |
| 2796 | if (list == NULL) |
| 2797 | status = FAIL; |
| 2798 | else |
| 2799 | { |
| 2800 | int i; |
| 2801 | Scheme_Object *curr = NULL; |
| 2802 | Scheme_Object *cval = NULL; |
| 2803 | /* temporary var to hold current element of vectors and pairs */ |
| 2804 | typval_T *v; |
| 2805 | |
| 2806 | MZ_GC_DECL_REG(2); |
| 2807 | MZ_GC_VAR_IN_REG(0, curr); |
| 2808 | MZ_GC_VAR_IN_REG(1, cval); |
| 2809 | MZ_GC_REG(); |
| 2810 | |
| 2811 | tv->v_type = VAR_LIST; |
| 2812 | tv->vval.v_list = list; |
| 2813 | ++list->lv_refcount; |
| 2814 | |
| 2815 | v = (typval_T *)alloc(sizeof(typval_T)); |
| 2816 | if (v == NULL) |
| 2817 | status = FAIL; |
| 2818 | else |
| 2819 | { |
| 2820 | /* add the value in advance to allow handling of self-referencial |
| 2821 | * data structures */ |
| 2822 | typval_T *visited_tv = (typval_T *)alloc(sizeof(typval_T)); |
| 2823 | copy_tv(tv, visited_tv); |
| 2824 | scheme_hash_set(visited, obj, (Scheme_Object *)visited_tv); |
| 2825 | |
| 2826 | if (SCHEME_VECTORP(obj)) |
| 2827 | { |
| 2828 | for (i = 0; i < SCHEME_VEC_SIZE(obj); ++i) |
| 2829 | { |
| 2830 | cval = SCHEME_VEC_ELS(obj)[i]; |
| 2831 | status = mzscheme_to_vim(cval, v, depth + 1, visited); |
| 2832 | if (status == FAIL) |
| 2833 | break; |
| 2834 | status = list_append_tv(list, v); |
| 2835 | clear_tv(v); |
| 2836 | if (status == FAIL) |
| 2837 | break; |
| 2838 | } |
| 2839 | } |
| 2840 | else if (SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj)) |
| 2841 | { |
| 2842 | for (curr = obj; |
| 2843 | SCHEME_PAIRP(curr) || SCHEME_MUTABLE_PAIRP(curr); |
| 2844 | curr = SCHEME_CDR(curr)) |
| 2845 | { |
| 2846 | cval = SCHEME_CAR(curr); |
| 2847 | status = mzscheme_to_vim(cval, v, depth + 1, visited); |
| 2848 | if (status == FAIL) |
| 2849 | break; |
| 2850 | status = list_append_tv(list, v); |
| 2851 | clear_tv(v); |
| 2852 | if (status == FAIL) |
| 2853 | break; |
| 2854 | } |
| 2855 | /* impoper list not terminated with null |
| 2856 | * need to handle the last element */ |
| 2857 | if (status == OK && !SCHEME_NULLP(curr)) |
| 2858 | { |
| 2859 | status = mzscheme_to_vim(cval, v, depth + 1, visited); |
| 2860 | if (status == OK) |
| 2861 | { |
| 2862 | status = list_append_tv(list, v); |
| 2863 | clear_tv(v); |
| 2864 | } |
| 2865 | } |
| 2866 | } |
| 2867 | /* nothing to do for scheme_null */ |
| 2868 | vim_free(v); |
| 2869 | } |
| 2870 | MZ_GC_UNREG(); |
| 2871 | } |
| 2872 | } |
| 2873 | else if (SCHEME_HASHTP(obj)) |
| 2874 | { |
| 2875 | int i; |
| 2876 | dict_T *dict; |
| 2877 | Scheme_Object *key = NULL; |
| 2878 | Scheme_Object *val = NULL; |
| 2879 | |
| 2880 | MZ_GC_DECL_REG(2); |
| 2881 | MZ_GC_VAR_IN_REG(0, key); |
| 2882 | MZ_GC_VAR_IN_REG(1, val); |
| 2883 | MZ_GC_REG(); |
| 2884 | |
| 2885 | dict = dict_alloc(); |
| 2886 | if (dict == NULL) |
| 2887 | status = FAIL; |
| 2888 | else |
| 2889 | { |
| 2890 | typval_T *visited_tv = (typval_T *)alloc(sizeof(typval_T)); |
| 2891 | |
| 2892 | tv->v_type = VAR_DICT; |
| 2893 | tv->vval.v_dict = dict; |
| 2894 | ++dict->dv_refcount; |
| 2895 | |
| 2896 | copy_tv(tv, visited_tv); |
| 2897 | scheme_hash_set(visited, obj, (Scheme_Object *)visited_tv); |
| 2898 | |
| 2899 | for (i = 0; i < ((Scheme_Hash_Table *)obj)->size; ++i) |
| 2900 | { |
| 2901 | if (((Scheme_Hash_Table *) obj)->vals[i] != NULL) |
| 2902 | { |
| 2903 | /* generate item for `diplay'ed Scheme key */ |
| 2904 | dictitem_T *item = dictitem_alloc((char_u *)string_to_line( |
| 2905 | ((Scheme_Hash_Table *) obj)->keys[i])); |
| 2906 | /* convert Scheme val to Vim and add it to the dict */ |
| 2907 | if (mzscheme_to_vim(((Scheme_Hash_Table *) obj)->vals[i], |
| 2908 | &item->di_tv, depth + 1, visited) == FAIL |
| 2909 | || dict_add(dict, item) == FAIL) |
| 2910 | { |
| 2911 | dictitem_free(item); |
| 2912 | status = FAIL; |
| 2913 | break; |
| 2914 | } |
| 2915 | } |
| 2916 | |
| 2917 | } |
| 2918 | } |
| 2919 | MZ_GC_UNREG(); |
| 2920 | } |
| 2921 | else |
| 2922 | { |
| 2923 | /* `display' any other value to string */ |
| 2924 | tv->v_type = VAR_STRING; |
| 2925 | tv->vval.v_string = (char_u *)string_to_line(obj); |
| 2926 | } |
| 2927 | return status; |
| 2928 | } |
| 2929 | |
| 2930 | void |
| 2931 | do_mzeval(char_u *str, typval_T *rettv) |
| 2932 | { |
| 2933 | int i; |
| 2934 | Scheme_Object *ret = NULL; |
| 2935 | Scheme_Hash_Table *visited = NULL; |
| 2936 | |
| 2937 | MZ_GC_DECL_REG(2); |
| 2938 | MZ_GC_VAR_IN_REG(0, ret); |
| 2939 | MZ_GC_VAR_IN_REG(0, visited); |
| 2940 | MZ_GC_REG(); |
| 2941 | |
| 2942 | if (mzscheme_init()) |
| 2943 | { |
| 2944 | MZ_GC_UNREG(); |
| 2945 | return; |
| 2946 | } |
| 2947 | |
| 2948 | MZ_GC_CHECK(); |
| 2949 | visited = scheme_make_hash_table(SCHEME_hash_ptr); |
| 2950 | MZ_GC_CHECK(); |
| 2951 | |
| 2952 | if (eval_with_exn_handling(str, do_eval, &ret) == OK) |
| 2953 | mzscheme_to_vim(ret, rettv, 1, visited); |
| 2954 | |
| 2955 | for (i = 0; i < visited->size; ++i) |
| 2956 | { |
| 2957 | /* free up remembered objects */ |
| 2958 | if (visited->vals[i] != NULL) |
| 2959 | { |
| 2960 | free_tv((typval_T *)visited->vals[i]); |
| 2961 | } |
| 2962 | } |
| 2963 | |
| 2964 | MZ_GC_UNREG(); |
| 2965 | } |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2966 | #endif |
| 2967 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2968 | /* |
| 2969 | * Check to see whether a Vim error has been reported, or a keyboard |
| 2970 | * interrupt (from vim --> got_int) has been detected. |
| 2971 | */ |
| 2972 | static int |
| 2973 | vim_error_check(void) |
| 2974 | { |
| 2975 | return (got_int || did_emsg); |
| 2976 | } |
| 2977 | |
| 2978 | /* |
| 2979 | * register Scheme exn:vim |
| 2980 | */ |
| 2981 | static void |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2982 | register_vim_exn(void) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2983 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 2984 | int nc = 0; |
| 2985 | int i; |
| 2986 | Scheme_Object *struct_exn = NULL; |
| 2987 | Scheme_Object *exn_name = NULL; |
| 2988 | |
| 2989 | MZ_GC_DECL_REG(2); |
| 2990 | MZ_GC_VAR_IN_REG(0, struct_exn); |
| 2991 | MZ_GC_VAR_IN_REG(1, exn_name); |
| 2992 | MZ_GC_REG(); |
| 2993 | |
| 2994 | exn_name = scheme_intern_symbol("exn:vim"); |
| 2995 | MZ_GC_CHECK(); |
| 2996 | struct_exn = scheme_builtin_value("struct:exn"); |
| 2997 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 2998 | |
| 2999 | if (vim_exn == NULL) |
| 3000 | vim_exn = scheme_make_struct_type(exn_name, |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3001 | struct_exn, NULL, 0, 0, NULL, NULL |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3002 | #if MZSCHEME_VERSION_MAJOR >= 299 |
| 3003 | , NULL |
| 3004 | #endif |
| 3005 | ); |
| 3006 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3007 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3008 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3009 | Scheme_Object **tmp = NULL; |
| 3010 | Scheme_Object *exn_names[5] = {NULL, NULL, NULL, NULL, NULL}; |
| 3011 | Scheme_Object *exn_values[5] = {NULL, NULL, NULL, NULL, NULL}; |
| 3012 | MZ_GC_DECL_REG(6); |
| 3013 | MZ_GC_ARRAY_VAR_IN_REG(0, exn_names, 5); |
| 3014 | MZ_GC_ARRAY_VAR_IN_REG(3, exn_values, 5); |
| 3015 | MZ_GC_REG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3016 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3017 | tmp = scheme_make_struct_names(exn_name, scheme_null, 0, &nc); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3018 | mch_memmove(exn_names, tmp, nc * sizeof(Scheme_Object *)); |
| 3019 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3020 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3021 | tmp = scheme_make_struct_values(vim_exn, exn_names, nc, 0); |
| 3022 | mch_memmove(exn_values, tmp, nc * sizeof(Scheme_Object *)); |
| 3023 | MZ_GC_CHECK(); |
| 3024 | |
| 3025 | for (i = 0; i < nc; i++) |
| 3026 | { |
| 3027 | scheme_add_global_symbol(exn_names[i], |
| 3028 | exn_values[i], environment); |
| 3029 | MZ_GC_CHECK(); |
| 3030 | } |
| 3031 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3032 | } |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3033 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3034 | } |
| 3035 | |
| 3036 | /* |
| 3037 | * raise exn:vim, may be with additional info string |
| 3038 | */ |
| 3039 | void |
| 3040 | raise_vim_exn(const char *add_info) |
| 3041 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3042 | char *fmt = _("Vim error: ~a"); |
| 3043 | Scheme_Object *argv[2] = {NULL, NULL}; |
| 3044 | Scheme_Object *exn = NULL; |
| 3045 | |
| 3046 | MZ_GC_DECL_REG(4); |
| 3047 | MZ_GC_ARRAY_VAR_IN_REG(0, argv, 2); |
| 3048 | MZ_GC_VAR_IN_REG(3, exn); |
| 3049 | MZ_GC_REG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3050 | |
| 3051 | if (add_info != NULL) |
| 3052 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3053 | char *c_string = NULL; |
| 3054 | Scheme_Object *byte_string = NULL; |
| 3055 | Scheme_Object *info = NULL; |
| 3056 | |
| 3057 | MZ_GC_DECL_REG(3); |
| 3058 | MZ_GC_VAR_IN_REG(0, c_string); |
| 3059 | MZ_GC_VAR_IN_REG(1, byte_string); |
| 3060 | MZ_GC_VAR_IN_REG(2, info); |
| 3061 | MZ_GC_REG(); |
| 3062 | |
| 3063 | info = scheme_make_string(add_info); |
| 3064 | MZ_GC_CHECK(); |
| 3065 | c_string = scheme_format(fmt, STRLEN(fmt), 1, &info, NULL); |
| 3066 | MZ_GC_CHECK(); |
| 3067 | byte_string = scheme_make_string(c_string); |
| 3068 | MZ_GC_CHECK(); |
| 3069 | argv[0] = scheme_byte_string_to_char_string(byte_string); |
| 3070 | MZ_GC_CHECK(); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 3071 | SCHEME_SET_IMMUTABLE(argv[0]); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3072 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3073 | } |
| 3074 | else |
| 3075 | argv[0] = scheme_make_string(_("Vim error")); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3076 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3077 | |
Bram Moolenaar | 049377e | 2007-05-12 15:32:12 +0000 | [diff] [blame] | 3078 | #if MZSCHEME_VERSION_MAJOR < 360 |
| 3079 | argv[1] = scheme_current_continuation_marks(); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3080 | MZ_GC_CHECK(); |
Bram Moolenaar | 049377e | 2007-05-12 15:32:12 +0000 | [diff] [blame] | 3081 | #else |
Bram Moolenaar | c81e5e7 | 2007-05-05 18:24:42 +0000 | [diff] [blame] | 3082 | argv[1] = scheme_current_continuation_marks(NULL); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3083 | MZ_GC_CHECK(); |
Bram Moolenaar | 049377e | 2007-05-12 15:32:12 +0000 | [diff] [blame] | 3084 | #endif |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3085 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3086 | exn = scheme_make_struct_instance(vim_exn, 2, argv); |
| 3087 | MZ_GC_CHECK(); |
| 3088 | scheme_raise(exn); |
| 3089 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3090 | } |
| 3091 | |
| 3092 | void |
| 3093 | raise_if_error(void) |
| 3094 | { |
| 3095 | if (vim_error_check()) |
| 3096 | raise_vim_exn(NULL); |
| 3097 | } |
| 3098 | |
| 3099 | /* get buffer: |
| 3100 | * either current |
| 3101 | * or passed as argv[argnum] with checks |
| 3102 | */ |
| 3103 | static vim_mz_buffer * |
| 3104 | get_buffer_arg(const char *fname, int argnum, int argc, Scheme_Object **argv) |
| 3105 | { |
| 3106 | vim_mz_buffer *b; |
| 3107 | |
| 3108 | if (argc < argnum + 1) |
| 3109 | return get_vim_curr_buffer(); |
| 3110 | if (!SCHEME_VIMBUFFERP(argv[argnum])) |
| 3111 | scheme_wrong_type(fname, "vim-buffer", argnum, argc, argv); |
| 3112 | b = (vim_mz_buffer *)argv[argnum]; |
| 3113 | (void)get_valid_buffer(argv[argnum]); |
| 3114 | return b; |
| 3115 | } |
| 3116 | |
| 3117 | /* get window: |
| 3118 | * either current |
| 3119 | * or passed as argv[argnum] with checks |
| 3120 | */ |
| 3121 | static vim_mz_window * |
| 3122 | get_window_arg(const char *fname, int argnum, int argc, Scheme_Object **argv) |
| 3123 | { |
| 3124 | vim_mz_window *w; |
| 3125 | |
| 3126 | if (argc < argnum + 1) |
| 3127 | return get_vim_curr_window(); |
| 3128 | w = (vim_mz_window *)argv[argnum]; |
| 3129 | if (!SCHEME_VIMWINDOWP(argv[argnum])) |
| 3130 | scheme_wrong_type(fname, "vim-window", argnum, argc, argv); |
| 3131 | (void)get_valid_window(argv[argnum]); |
| 3132 | return w; |
| 3133 | } |
| 3134 | |
| 3135 | /* get valid Vim buffer from Scheme_Object* */ |
| 3136 | buf_T *get_valid_buffer(void *obj) |
| 3137 | { |
| 3138 | buf_T *buf = ((vim_mz_buffer *)obj)->buf; |
| 3139 | |
| 3140 | if (buf == INVALID_BUFFER_VALUE) |
| 3141 | scheme_signal_error(_("buffer is invalid")); |
| 3142 | return buf; |
| 3143 | } |
| 3144 | |
| 3145 | /* get valid Vim window from Scheme_Object* */ |
| 3146 | win_T *get_valid_window(void *obj) |
| 3147 | { |
| 3148 | win_T *win = ((vim_mz_window *)obj)->win; |
| 3149 | if (win == INVALID_WINDOW_VALUE) |
| 3150 | scheme_signal_error(_("window is invalid")); |
| 3151 | return win; |
| 3152 | } |
| 3153 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3154 | int |
| 3155 | mzthreads_allowed(void) |
| 3156 | { |
| 3157 | return mz_threads_allow; |
| 3158 | } |
| 3159 | |
| 3160 | static int |
| 3161 | line_in_range(linenr_T lnum, buf_T *buf) |
| 3162 | { |
| 3163 | return (lnum > 0 && lnum <= buf->b_ml.ml_line_count); |
| 3164 | } |
| 3165 | |
| 3166 | static void |
| 3167 | check_line_range(linenr_T lnum, buf_T *buf) |
| 3168 | { |
| 3169 | if (!line_in_range(lnum, buf)) |
| 3170 | scheme_signal_error(_("linenr out of range")); |
| 3171 | } |
| 3172 | |
| 3173 | /* |
| 3174 | * Check if deleting lines made the cursor position invalid |
| 3175 | * (or you'll get msg from Vim about invalid linenr). |
| 3176 | * Changed the lines from "lo" to "hi" and added "extra" lines (negative if |
| 3177 | * deleted). Got from if_python.c |
| 3178 | */ |
| 3179 | static void |
| 3180 | mz_fix_cursor(int lo, int hi, int extra) |
| 3181 | { |
| 3182 | if (curwin->w_cursor.lnum >= lo) |
| 3183 | { |
| 3184 | /* Adjust the cursor position if it's in/after the changed |
| 3185 | * lines. */ |
| 3186 | if (curwin->w_cursor.lnum >= hi) |
| 3187 | { |
| 3188 | curwin->w_cursor.lnum += extra; |
| 3189 | check_cursor_col(); |
| 3190 | } |
| 3191 | else if (extra < 0) |
| 3192 | { |
| 3193 | curwin->w_cursor.lnum = lo; |
| 3194 | check_cursor(); |
| 3195 | } |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3196 | else |
| 3197 | check_cursor_col(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3198 | changed_cline_bef_curs(); |
| 3199 | } |
| 3200 | invalidate_botline(); |
| 3201 | } |
| 3202 | |
| 3203 | static Vim_Prim prims[]= |
| 3204 | { |
| 3205 | /* |
| 3206 | * Buffer-related commands |
| 3207 | */ |
| 3208 | {get_buffer_line, "get-buff-line", 1, 2}, |
| 3209 | {set_buffer_line, "set-buff-line", 2, 3}, |
| 3210 | {get_buffer_line_list, "get-buff-line-list", 2, 3}, |
| 3211 | {get_buffer_name, "get-buff-name", 0, 1}, |
| 3212 | {get_buffer_num, "get-buff-num", 0, 1}, |
| 3213 | {get_buffer_size, "get-buff-size", 0, 1}, |
| 3214 | {set_buffer_line_list, "set-buff-line-list", 3, 4}, |
| 3215 | {insert_buffer_line_list, "insert-buff-line-list", 2, 3}, |
| 3216 | {get_curr_buffer, "curr-buff", 0, 0}, |
| 3217 | {get_buffer_count, "buff-count", 0, 0}, |
| 3218 | {get_next_buffer, "get-next-buff", 0, 1}, |
| 3219 | {get_prev_buffer, "get-prev-buff", 0, 1}, |
| 3220 | {mzscheme_open_buffer, "open-buff", 1, 1}, |
| 3221 | {get_buffer_by_name, "get-buff-by-name", 1, 1}, |
| 3222 | {get_buffer_by_num, "get-buff-by-num", 1, 1}, |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3223 | /* |
| 3224 | * Window-related commands |
| 3225 | */ |
| 3226 | {get_curr_win, "curr-win", 0, 0}, |
| 3227 | {get_window_count, "win-count", 0, 0}, |
| 3228 | {get_window_by_num, "get-win-by-num", 1, 1}, |
| 3229 | {get_window_num, "get-win-num", 0, 1}, |
| 3230 | {get_window_buffer, "get-win-buffer", 0, 1}, |
| 3231 | {get_window_height, "get-win-height", 0, 1}, |
| 3232 | {set_window_height, "set-win-height", 1, 2}, |
| 3233 | #ifdef FEAT_VERTSPLIT |
| 3234 | {get_window_width, "get-win-width", 0, 1}, |
| 3235 | {set_window_width, "set-win-width", 1, 2}, |
| 3236 | #endif |
| 3237 | {get_cursor, "get-cursor", 0, 1}, |
| 3238 | {set_cursor, "set-cursor", 1, 2}, |
| 3239 | {get_window_list, "get-win-list", 0, 1}, |
| 3240 | /* |
| 3241 | * Vim-related commands |
| 3242 | */ |
| 3243 | {vim_command, "command", 1, 1}, |
| 3244 | {vim_eval, "eval", 1, 1}, |
| 3245 | {get_range_start, "range-start", 0, 0}, |
| 3246 | {get_range_end, "range-end", 0, 0}, |
| 3247 | {mzscheme_beep, "beep", 0, 0}, |
| 3248 | {get_option, "get-option", 1, 2}, |
| 3249 | {set_option, "set-option", 1, 2}, |
| 3250 | /* |
| 3251 | * small utilities |
| 3252 | */ |
| 3253 | {vim_bufferp, "buff?", 1, 1}, |
| 3254 | {vim_windowp, "win?", 1, 1}, |
| 3255 | {vim_buffer_validp, "buff-valid?", 1, 1}, |
| 3256 | {vim_window_validp, "win-valid?", 1, 1} |
| 3257 | }; |
| 3258 | |
| 3259 | /* return MzScheme wrapper for curbuf */ |
| 3260 | static vim_mz_buffer * |
| 3261 | get_vim_curr_buffer(void) |
| 3262 | { |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 3263 | if (curbuf->b_mzscheme_ref == NULL) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3264 | return (vim_mz_buffer *)buffer_new(curbuf); |
| 3265 | else |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 3266 | return (vim_mz_buffer *)curbuf->b_mzscheme_ref; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3267 | } |
| 3268 | |
| 3269 | /* return MzScheme wrapper for curwin */ |
| 3270 | static vim_mz_window * |
| 3271 | get_vim_curr_window(void) |
| 3272 | { |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 3273 | if (curwin->w_mzscheme_ref == NULL) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3274 | return (vim_mz_window *)window_new(curwin); |
| 3275 | else |
Bram Moolenaar | e344bea | 2005-09-01 20:46:49 +0000 | [diff] [blame] | 3276 | return (vim_mz_window *)curwin->w_mzscheme_ref; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3277 | } |
| 3278 | |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3279 | static void |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3280 | make_modules() |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3281 | { |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3282 | int i; |
| 3283 | Scheme_Env *mod = NULL; |
| 3284 | Scheme_Object *vimext_symbol = NULL; |
| 3285 | Scheme_Object *closed_prim = NULL; |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3286 | |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3287 | MZ_GC_DECL_REG(3); |
| 3288 | MZ_GC_VAR_IN_REG(0, mod); |
| 3289 | MZ_GC_VAR_IN_REG(1, vimext_symbol); |
| 3290 | MZ_GC_VAR_IN_REG(2, closed_prim); |
| 3291 | MZ_GC_REG(); |
| 3292 | |
| 3293 | vimext_symbol = scheme_intern_symbol("vimext"); |
| 3294 | MZ_GC_CHECK(); |
| 3295 | mod = scheme_primitive_module(vimext_symbol, environment); |
| 3296 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3297 | /* all prims made closed so they can access their own names */ |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3298 | for (i = 0; i < (int)(sizeof(prims)/sizeof(prims[0])); i++) |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3299 | { |
| 3300 | Vim_Prim *prim = prims + i; |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3301 | closed_prim = scheme_make_closed_prim_w_arity(prim->prim, prim, prim->name, |
| 3302 | prim->mina, prim->maxa); |
| 3303 | scheme_add_global(prim->name, closed_prim, mod); |
| 3304 | MZ_GC_CHECK(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3305 | } |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3306 | scheme_finish_primitive_module(mod); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3307 | MZ_GC_CHECK(); |
| 3308 | MZ_GC_UNREG(); |
Bram Moolenaar | 325b7a2 | 2004-07-05 15:58:32 +0000 | [diff] [blame] | 3309 | } |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 3310 | |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 3311 | #ifdef HAVE_SANDBOX |
| 3312 | static Scheme_Object *M_write = NULL; |
| 3313 | static Scheme_Object *M_read = NULL; |
| 3314 | static Scheme_Object *M_execute = NULL; |
| 3315 | static Scheme_Object *M_delete = NULL; |
| 3316 | |
| 3317 | static void |
Bram Moolenaar | c81e5e7 | 2007-05-05 18:24:42 +0000 | [diff] [blame] | 3318 | sandbox_check(void) |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 3319 | { |
| 3320 | if (sandbox) |
| 3321 | raise_vim_exn(_("not allowed in the Vim sandbox")); |
| 3322 | } |
| 3323 | |
Bram Moolenaar | d857f0e | 2005-06-21 22:37:39 +0000 | [diff] [blame] | 3324 | /* security guards to force Vim's sandbox restrictions on MzScheme level */ |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 3325 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 3326 | sandbox_file_guard(int argc UNUSED, Scheme_Object **argv) |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 3327 | { |
| 3328 | if (sandbox) |
| 3329 | { |
| 3330 | Scheme_Object *requested_access = argv[2]; |
| 3331 | |
| 3332 | if (M_write == NULL) |
| 3333 | { |
| 3334 | MZ_REGISTER_STATIC(M_write); |
| 3335 | M_write = scheme_intern_symbol("write"); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3336 | MZ_GC_CHECK(); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 3337 | } |
| 3338 | if (M_read == NULL) |
| 3339 | { |
| 3340 | MZ_REGISTER_STATIC(M_read); |
| 3341 | M_read = scheme_intern_symbol("read"); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3342 | MZ_GC_CHECK(); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 3343 | } |
| 3344 | if (M_execute == NULL) |
| 3345 | { |
| 3346 | MZ_REGISTER_STATIC(M_execute); |
| 3347 | M_execute = scheme_intern_symbol("execute"); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3348 | MZ_GC_CHECK(); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 3349 | } |
| 3350 | if (M_delete == NULL) |
| 3351 | { |
| 3352 | MZ_REGISTER_STATIC(M_delete); |
| 3353 | M_delete = scheme_intern_symbol("delete"); |
Bram Moolenaar | 9e70cf1 | 2009-05-26 20:59:55 +0000 | [diff] [blame] | 3354 | MZ_GC_CHECK(); |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 3355 | } |
| 3356 | |
| 3357 | while (!SCHEME_NULLP(requested_access)) |
| 3358 | { |
| 3359 | Scheme_Object *item = SCHEME_CAR(requested_access); |
| 3360 | if (scheme_eq(item, M_write) || scheme_eq(item, M_read) |
| 3361 | || scheme_eq(item, M_execute) || scheme_eq(item, M_delete)) |
| 3362 | { |
| 3363 | raise_vim_exn(_("not allowed in the Vim sandbox")); |
| 3364 | } |
| 3365 | requested_access = SCHEME_CDR(requested_access); |
| 3366 | } |
| 3367 | } |
| 3368 | return scheme_void; |
| 3369 | } |
| 3370 | |
| 3371 | static Scheme_Object * |
Bram Moolenaar | 6440447 | 2010-06-26 06:24:45 +0200 | [diff] [blame] | 3372 | sandbox_network_guard(int argc UNUSED, Scheme_Object **argv UNUSED) |
Bram Moolenaar | 555b280 | 2005-05-19 21:08:39 +0000 | [diff] [blame] | 3373 | { |
| 3374 | return scheme_void; |
| 3375 | } |
| 3376 | #endif |
Bram Moolenaar | 76b92b2 | 2006-03-24 22:46:53 +0000 | [diff] [blame] | 3377 | |
| 3378 | #endif |