src/if_mzsch.c

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