blob: d6ee4b9c5a0717bce2f87c58815698970ae70eb6 [file] [log] [blame]
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001/* vi:set ts=8 sts=4 sw=4:
2 *
Bram Moolenaar2e6aff32005-01-31 19:25:36 +00003 * MzScheme interface by Sergey Khorev <sergey.khorev@gmail.com>
Bram Moolenaar325b7a22004-07-05 15:58:32 +00004 * Original work by Brent Fulgham <bfulgham@debian.org>
5 * (Based on lots of help from Matthew Flatt)
6 *
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00007 * TODO Convert byte-strings to char strings?
8 *
Bram Moolenaar325b7a22004-07-05 15:58:32 +00009 * This consists of six parts:
10 * 1. MzScheme interpreter main program
11 * 2. Routines that handle the external interface between MzScheme and
12 * Vim.
13 * 3. MzScheme input/output handlers: writes output via [e]msg().
14 * 4. Implementation of the Vim Features for MzScheme
15 * 5. Vim Window-related Manipulation Functions.
16 * 6. Vim Buffer-related Manipulation Functions
17 *
18 * NOTES
19 * 1. Memory, allocated with scheme_malloc*, need not to be freed explicitly,
20 * garbage collector will do it self
21 * 2. Requires at least NORMAL features. I can't imagine why one may want
22 * to build with SMALL or TINY features but with MzScheme interface.
Bram Moolenaar9e70cf12009-05-26 20:59:55 +000023 * 3. I don't use K&R-style functions. Anyways, MzScheme headers are ANSI.
Bram Moolenaar325b7a22004-07-05 15:58:32 +000024 */
25
Bram Moolenaar325b7a22004-07-05 15:58:32 +000026#include "vim.h"
Bram Moolenaar049377e2007-05-12 15:32:12 +000027
Bram Moolenaar325b7a22004-07-05 15:58:32 +000028#include "if_mzsch.h"
29
Bram Moolenaar76b92b22006-03-24 22:46:53 +000030/* Only do the following when the feature is enabled. Needed for "make
31 * depend". */
32#if defined(FEAT_MZSCHEME) || defined(PROTO)
33
Bram Moolenaar325b7a22004-07-05 15:58:32 +000034/* Base data structures */
35#define SCHEME_VIMBUFFERP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type)
36#define SCHEME_VIMWINDOWP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_window_type)
37
38typedef struct
39{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +000040 Scheme_Object so;
Bram Moolenaar325b7a22004-07-05 15:58:32 +000041 buf_T *buf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +000042} vim_mz_buffer;
43
44#define INVALID_BUFFER_VALUE ((buf_T *)(-1))
45
46typedef struct
47{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +000048 Scheme_Object so;
Bram Moolenaar1d2ba7f2006-02-14 22:29:30 +000049 win_T *win;
Bram Moolenaar325b7a22004-07-05 15:58:32 +000050} vim_mz_window;
51
52#define INVALID_WINDOW_VALUE ((win_T *)(-1))
53
54/*
55 * Prims that form MzScheme Vim interface
56 */
57typedef struct
58{
59 Scheme_Closed_Prim *prim;
60 char *name;
61 int mina; /* arity information */
62 int maxa;
63} Vim_Prim;
64
65typedef struct
66{
67 char *name;
68 Scheme_Object *port;
69} Port_Info;
70
Bram Moolenaar325b7a22004-07-05 15:58:32 +000071/*
72 *========================================================================
73 * Vim-Control Commands
74 *========================================================================
75 */
76/*
77 *========================================================================
78 * Utility functions for the vim/mzscheme interface
79 *========================================================================
80 */
Bram Moolenaar555b2802005-05-19 21:08:39 +000081#ifdef HAVE_SANDBOX
82static Scheme_Object *sandbox_file_guard(int, Scheme_Object **);
83static Scheme_Object *sandbox_network_guard(int, Scheme_Object **);
Bram Moolenaarc81e5e72007-05-05 18:24:42 +000084static void sandbox_check(void);
Bram Moolenaar555b2802005-05-19 21:08:39 +000085#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +000086/* Buffer-related commands */
87static Scheme_Object *buffer_new(buf_T *buf);
88static Scheme_Object *get_buffer_by_name(void *, int, Scheme_Object **);
89static Scheme_Object *get_buffer_by_num(void *, int, Scheme_Object **);
90static Scheme_Object *get_buffer_count(void *, int, Scheme_Object **);
91static Scheme_Object *get_buffer_line(void *, int, Scheme_Object **);
92static Scheme_Object *get_buffer_line_list(void *, int, Scheme_Object **);
93static Scheme_Object *get_buffer_name(void *, int, Scheme_Object **);
94static Scheme_Object *get_buffer_num(void *, int, Scheme_Object **);
95static Scheme_Object *get_buffer_size(void *, int, Scheme_Object **);
96static Scheme_Object *get_curr_buffer(void *, int, Scheme_Object **);
97static Scheme_Object *get_next_buffer(void *, int, Scheme_Object **);
98static Scheme_Object *get_prev_buffer(void *, int, Scheme_Object **);
99static Scheme_Object *mzscheme_open_buffer(void *, int, Scheme_Object **);
100static Scheme_Object *set_buffer_line(void *, int, Scheme_Object **);
101static Scheme_Object *set_buffer_line_list(void *, int, Scheme_Object **);
102static Scheme_Object *insert_buffer_line_list(void *, int, Scheme_Object **);
103static Scheme_Object *get_range_start(void *, int, Scheme_Object **);
104static Scheme_Object *get_range_end(void *, int, Scheme_Object **);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000105static vim_mz_buffer *get_vim_curr_buffer(void);
106
107/* Window-related commands */
108static Scheme_Object *window_new(win_T *win);
109static Scheme_Object *get_curr_win(void *, int, Scheme_Object **);
110static Scheme_Object *get_window_count(void *, int, Scheme_Object **);
111static Scheme_Object *get_window_by_num(void *, int, Scheme_Object **);
112static Scheme_Object *get_window_num(void *, int, Scheme_Object **);
113static Scheme_Object *get_window_buffer(void *, int, Scheme_Object **);
114static Scheme_Object *get_window_height(void *, int, Scheme_Object **);
115static Scheme_Object *set_window_height(void *, int, Scheme_Object **);
116#ifdef FEAT_VERTSPLIT
117static Scheme_Object *get_window_width(void *, int, Scheme_Object **);
118static Scheme_Object *set_window_width(void *, int, Scheme_Object **);
119#endif
120static Scheme_Object *get_cursor(void *, int, Scheme_Object **);
121static Scheme_Object *set_cursor(void *, int, Scheme_Object **);
122static Scheme_Object *get_window_list(void *, int, Scheme_Object **);
123static vim_mz_window *get_vim_curr_window(void);
124
125/* Vim-related commands */
126static Scheme_Object *mzscheme_beep(void *, int, Scheme_Object **);
127static Scheme_Object *get_option(void *, int, Scheme_Object **);
128static Scheme_Object *set_option(void *, int, Scheme_Object **);
129static Scheme_Object *vim_command(void *, int, Scheme_Object **);
130static Scheme_Object *vim_eval(void *, int, Scheme_Object **);
131static Scheme_Object *vim_bufferp(void *data, int, Scheme_Object **);
132static Scheme_Object *vim_windowp(void *data, int, Scheme_Object **);
133static Scheme_Object *vim_buffer_validp(void *data, int, Scheme_Object **);
134static Scheme_Object *vim_window_validp(void *data, int, Scheme_Object **);
135
136/*
137 *========================================================================
138 * Internal Function Prototypes
139 *========================================================================
140 */
141static int vim_error_check(void);
142static int do_mzscheme_command(exarg_T *, void *, Scheme_Closed_Prim *what);
143static void startup_mzscheme(void);
144static char *string_to_line(Scheme_Object *obj);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000145static void do_output(char *mesg, long len);
146static void do_printf(char *format, ...);
147static void do_flush(void);
148static Scheme_Object *_apply_thunk_catch_exceptions(
149 Scheme_Object *, Scheme_Object **);
150static Scheme_Object *extract_exn_message(Scheme_Object *v);
151static Scheme_Object *do_eval(void *, int noargc, Scheme_Object **noargv);
152static Scheme_Object *do_load(void *, int noargc, Scheme_Object **noargv);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000153static void register_vim_exn(void);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000154static vim_mz_buffer *get_buffer_arg(const char *fname, int argnum,
155 int argc, Scheme_Object **argv);
156static vim_mz_window *get_window_arg(const char *fname, int argnum,
157 int argc, Scheme_Object **argv);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000158static int line_in_range(linenr_T, buf_T *);
159static void check_line_range(linenr_T, buf_T *);
160static void mz_fix_cursor(int lo, int hi, int extra);
161
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000162static int eval_with_exn_handling(void *, Scheme_Closed_Prim *,
163 Scheme_Object **ret);
164static void make_modules(void);
165static void init_exn_catching_apply(void);
166static int mzscheme_env_main(Scheme_Env *env, int argc, char **argv);
167static int mzscheme_init(void);
168#ifdef FEAT_EVAL
169static Scheme_Object *vim_to_mzscheme(typval_T *vim_value, int depth,
170 Scheme_Hash_Table *visited);
Bram Moolenaar7e506b62010-01-19 15:55:06 +0100171static int mzscheme_to_vim(Scheme_Object *obj, typval_T *tv, int depth,
172 Scheme_Hash_Table *visited);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000173#endif
174
175#ifdef MZ_PRECISE_GC
Bram Moolenaar64404472010-06-26 06:24:45 +0200176static int buffer_size_proc(void *obj UNUSED)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000177{
178 return gcBYTES_TO_WORDS(sizeof(vim_mz_buffer));
179}
180static int buffer_mark_proc(void *obj)
181{
182 return buffer_size_proc(obj);
183}
184static int buffer_fixup_proc(void *obj)
185{
186 return buffer_size_proc(obj);
187}
Bram Moolenaar64404472010-06-26 06:24:45 +0200188static int window_size_proc(void *obj UNUSED)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000189{
190 return gcBYTES_TO_WORDS(sizeof(vim_mz_window));
191}
192static int window_mark_proc(void *obj)
193{
194 return window_size_proc(obj);
195}
196static int window_fixup_proc(void *obj)
197{
198 return window_size_proc(obj);
199}
200#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000201
Bram Moolenaar33570922005-01-25 22:26:29 +0000202#ifdef DYNAMIC_MZSCHEME
203
204static Scheme_Object *dll_scheme_eof;
205static Scheme_Object *dll_scheme_false;
206static Scheme_Object *dll_scheme_void;
207static Scheme_Object *dll_scheme_null;
208static Scheme_Object *dll_scheme_true;
209
210static Scheme_Thread **dll_scheme_current_thread_ptr;
211
212static void (**dll_scheme_console_printf_ptr)(char *str, ...);
213static void (**dll_scheme_console_output_ptr)(char *str, long len);
214static void (**dll_scheme_notify_multithread_ptr)(int on);
215
216static void *(*dll_GC_malloc)(size_t size_in_bytes);
217static void *(*dll_GC_malloc_atomic)(size_t size_in_bytes);
218static Scheme_Env *(*dll_scheme_basic_env)(void);
219static void (*dll_scheme_check_threads)(void);
220static void (*dll_scheme_register_static)(void *ptr, long size);
221static void (*dll_scheme_set_stack_base)(void *base, int no_auto_statics);
222static void (*dll_scheme_add_global)(const char *name, Scheme_Object *val,
223 Scheme_Env *env);
224static void (*dll_scheme_add_global_symbol)(Scheme_Object *name,
225 Scheme_Object *val, Scheme_Env *env);
226static Scheme_Object *(*dll_scheme_apply)(Scheme_Object *rator, int num_rands,
227 Scheme_Object **rands);
228static Scheme_Object *(*dll_scheme_builtin_value)(const char *name);
Bram Moolenaar555b2802005-05-19 21:08:39 +0000229# if MZSCHEME_VERSION_MAJOR >= 299
230static Scheme_Object *(*dll_scheme_byte_string_to_char_string)(Scheme_Object *s);
231# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000232static void (*dll_scheme_close_input_port)(Scheme_Object *port);
233static void (*dll_scheme_count_lines)(Scheme_Object *port);
Bram Moolenaar049377e2007-05-12 15:32:12 +0000234#if MZSCHEME_VERSION_MAJOR < 360
Bram Moolenaar33570922005-01-25 22:26:29 +0000235static Scheme_Object *(*dll_scheme_current_continuation_marks)(void);
Bram Moolenaar049377e2007-05-12 15:32:12 +0000236#else
237static Scheme_Object *(*dll_scheme_current_continuation_marks)(Scheme_Object *prompt_tag);
238#endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000239static void (*dll_scheme_display)(Scheme_Object *obj, Scheme_Object *port);
240static char *(*dll_scheme_display_to_string)(Scheme_Object *obj, long *len);
Bram Moolenaar555b2802005-05-19 21:08:39 +0000241static int (*dll_scheme_eq)(Scheme_Object *obj1, Scheme_Object *obj2);
Bram Moolenaar33570922005-01-25 22:26:29 +0000242static Scheme_Object *(*dll_scheme_do_eval)(Scheme_Object *obj,
243 int _num_rands, Scheme_Object **rands, int val);
244static void (*dll_scheme_dont_gc_ptr)(void *p);
245static Scheme_Object *(*dll_scheme_eval)(Scheme_Object *obj, Scheme_Env *env);
246static Scheme_Object *(*dll_scheme_eval_string)(const char *str,
247 Scheme_Env *env);
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000248static Scheme_Object *(*dll_scheme_eval_string_all)(const char *str,
Bram Moolenaar33570922005-01-25 22:26:29 +0000249 Scheme_Env *env, int all);
250static void (*dll_scheme_finish_primitive_module)(Scheme_Env *env);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000251# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar33570922005-01-25 22:26:29 +0000252static char *(*dll_scheme_format)(char *format, int flen, int argc,
253 Scheme_Object **argv, long *rlen);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000254# else
255static char *(*dll_scheme_format_utf8)(char *format, int flen, int argc,
256 Scheme_Object **argv, long *rlen);
Bram Moolenaar555b2802005-05-19 21:08:39 +0000257static Scheme_Object *(*dll_scheme_get_param)(Scheme_Config *c, int pos);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000258# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000259static void (*dll_scheme_gc_ptr_ok)(void *p);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000260# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar33570922005-01-25 22:26:29 +0000261static char *(*dll_scheme_get_sized_string_output)(Scheme_Object *,
262 long *len);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000263# else
264static char *(*dll_scheme_get_sized_byte_string_output)(Scheme_Object *,
265 long *len);
266# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000267static Scheme_Object *(*dll_scheme_intern_symbol)(const char *name);
268static Scheme_Object *(*dll_scheme_lookup_global)(Scheme_Object *symbol,
269 Scheme_Env *env);
270static Scheme_Object *(*dll_scheme_make_closed_prim_w_arity)
271 (Scheme_Closed_Prim *prim, void *data, const char *name, mzshort mina,
272 mzshort maxa);
273static Scheme_Object *(*dll_scheme_make_integer_value)(long i);
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000274static Scheme_Object *(*dll_scheme_make_pair)(Scheme_Object *car,
Bram Moolenaar33570922005-01-25 22:26:29 +0000275 Scheme_Object *cdr);
Bram Moolenaar555b2802005-05-19 21:08:39 +0000276static Scheme_Object *(*dll_scheme_make_prim_w_arity)(Scheme_Prim *prim,
277 const char *name, mzshort mina, mzshort maxa);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000278# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar33570922005-01-25 22:26:29 +0000279static Scheme_Object *(*dll_scheme_make_string)(const char *chars);
280static Scheme_Object *(*dll_scheme_make_string_output_port)();
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000281# else
282static Scheme_Object *(*dll_scheme_make_byte_string)(const char *chars);
283static Scheme_Object *(*dll_scheme_make_byte_string_output_port)();
284# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000285static Scheme_Object *(*dll_scheme_make_struct_instance)(Scheme_Object *stype,
286 int argc, Scheme_Object **argv);
287static Scheme_Object **(*dll_scheme_make_struct_names)(Scheme_Object *base,
288 Scheme_Object *field_names, int flags, int *count_out);
289static Scheme_Object *(*dll_scheme_make_struct_type)(Scheme_Object *base,
290 Scheme_Object *parent, Scheme_Object *inspector, int num_fields,
291 int num_uninit_fields, Scheme_Object *uninit_val,
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000292 Scheme_Object *properties
293# if MZSCHEME_VERSION_MAJOR >= 299
294 , Scheme_Object *guard
295# endif
296 );
Bram Moolenaar33570922005-01-25 22:26:29 +0000297static Scheme_Object **(*dll_scheme_make_struct_values)(
298 Scheme_Object *struct_type, Scheme_Object **names, int count,
299 int flags);
300static Scheme_Type (*dll_scheme_make_type)(const char *name);
301static Scheme_Object *(*dll_scheme_make_vector)(int size,
302 Scheme_Object *fill);
303static void *(*dll_scheme_malloc_fail_ok)(void *(*f)(size_t), size_t);
304static Scheme_Object *(*dll_scheme_open_input_file)(const char *name,
305 const char *who);
306static Scheme_Env *(*dll_scheme_primitive_module)(Scheme_Object *name,
307 Scheme_Env *for_env);
308static int (*dll_scheme_proper_list_length)(Scheme_Object *list);
309static void (*dll_scheme_raise)(Scheme_Object *exn);
310static Scheme_Object *(*dll_scheme_read)(Scheme_Object *port);
311static void (*dll_scheme_signal_error)(const char *msg, ...);
312static void (*dll_scheme_wrong_type)(const char *name, const char *expected,
313 int which, int argc, Scheme_Object **argv);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000314# if MZSCHEME_VERSION_MAJOR >= 299
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000315static void (*dll_scheme_set_param)(Scheme_Config *c, int pos,
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000316 Scheme_Object *o);
317static Scheme_Config *(*dll_scheme_current_config)(void);
318static Scheme_Object *(*dll_scheme_char_string_to_byte_string)
319 (Scheme_Object *s);
Bram Moolenaare2a49d82007-07-06 17:43:08 +0000320static Scheme_Object *(*dll_scheme_char_string_to_path)
321 (Scheme_Object *s);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000322# endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000323static Scheme_Hash_Table *(*dll_scheme_make_hash_table)(int type);
324static void (*dll_scheme_hash_set)(Scheme_Hash_Table *table,
325 Scheme_Object *key, Scheme_Object *value);
326static Scheme_Object *(*dll_scheme_hash_get)(Scheme_Hash_Table *table,
327 Scheme_Object *key);
328static Scheme_Object *(*dll_scheme_make_double)(double d);
329# ifdef INCLUDE_MZSCHEME_BASE
330static Scheme_Object *(*dll_scheme_make_sized_byte_string)(char *chars,
331 long len, int copy);
332static Scheme_Object *(*dll_scheme_namespace_require)(Scheme_Object *req);
333# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000334
335/* arrays are imported directly */
336# define scheme_eof dll_scheme_eof
337# define scheme_false dll_scheme_false
338# define scheme_void dll_scheme_void
339# define scheme_null dll_scheme_null
340# define scheme_true dll_scheme_true
341
342/* pointers are GetProceAddress'ed as pointers to pointer */
343# define scheme_current_thread (*dll_scheme_current_thread_ptr)
344# define scheme_console_printf (*dll_scheme_console_printf_ptr)
345# define scheme_console_output (*dll_scheme_console_output_ptr)
346# define scheme_notify_multithread (*dll_scheme_notify_multithread_ptr)
347
348/* and functions in a usual way */
349# define GC_malloc dll_GC_malloc
350# define GC_malloc_atomic dll_GC_malloc_atomic
351
352# define scheme_add_global dll_scheme_add_global
353# define scheme_add_global_symbol dll_scheme_add_global_symbol
354# define scheme_apply dll_scheme_apply
355# define scheme_basic_env dll_scheme_basic_env
356# define scheme_builtin_value dll_scheme_builtin_value
Bram Moolenaar555b2802005-05-19 21:08:39 +0000357# if MZSCHEME_VERSION_MAJOR >= 299
358# define scheme_byte_string_to_char_string dll_scheme_byte_string_to_char_string
359# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000360# define scheme_check_threads dll_scheme_check_threads
361# define scheme_close_input_port dll_scheme_close_input_port
362# define scheme_count_lines dll_scheme_count_lines
363# define scheme_current_continuation_marks \
364 dll_scheme_current_continuation_marks
365# define scheme_display dll_scheme_display
366# define scheme_display_to_string dll_scheme_display_to_string
367# define scheme_do_eval dll_scheme_do_eval
368# define scheme_dont_gc_ptr dll_scheme_dont_gc_ptr
Bram Moolenaar555b2802005-05-19 21:08:39 +0000369# define scheme_eq dll_scheme_eq
Bram Moolenaar33570922005-01-25 22:26:29 +0000370# define scheme_eval dll_scheme_eval
371# define scheme_eval_string dll_scheme_eval_string
372# define scheme_eval_string_all dll_scheme_eval_string_all
373# define scheme_finish_primitive_module dll_scheme_finish_primitive_module
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000374# if MZSCHEME_VERSION_MAJOR < 299
375# define scheme_format dll_scheme_format
376# else
377# define scheme_format_utf8 dll_scheme_format_utf8
378# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000379# define scheme_gc_ptr_ok dll_scheme_gc_ptr_ok
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000380# if MZSCHEME_VERSION_MAJOR < 299
381# define scheme_get_sized_string_output dll_scheme_get_sized_string_output
382# else
383# define scheme_get_sized_byte_string_output \
384 dll_scheme_get_sized_byte_string_output
Bram Moolenaar555b2802005-05-19 21:08:39 +0000385# define scheme_get_param dll_scheme_get_param
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000386# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000387# define scheme_intern_symbol dll_scheme_intern_symbol
388# define scheme_lookup_global dll_scheme_lookup_global
389# define scheme_make_closed_prim_w_arity dll_scheme_make_closed_prim_w_arity
390# define scheme_make_integer_value dll_scheme_make_integer_value
Bram Moolenaar33570922005-01-25 22:26:29 +0000391# define scheme_make_pair dll_scheme_make_pair
Bram Moolenaar555b2802005-05-19 21:08:39 +0000392# define scheme_make_prim_w_arity dll_scheme_make_prim_w_arity
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000393# if MZSCHEME_VERSION_MAJOR < 299
394# define scheme_make_string dll_scheme_make_string
395# define scheme_make_string_output_port dll_scheme_make_string_output_port
396# else
397# define scheme_make_byte_string dll_scheme_make_byte_string
398# define scheme_make_byte_string_output_port \
399 dll_scheme_make_byte_string_output_port
400# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000401# define scheme_make_struct_instance dll_scheme_make_struct_instance
402# define scheme_make_struct_names dll_scheme_make_struct_names
403# define scheme_make_struct_type dll_scheme_make_struct_type
404# define scheme_make_struct_values dll_scheme_make_struct_values
405# define scheme_make_type dll_scheme_make_type
406# define scheme_make_vector dll_scheme_make_vector
407# define scheme_malloc_fail_ok dll_scheme_malloc_fail_ok
408# define scheme_open_input_file dll_scheme_open_input_file
409# define scheme_primitive_module dll_scheme_primitive_module
410# define scheme_proper_list_length dll_scheme_proper_list_length
411# define scheme_raise dll_scheme_raise
412# define scheme_read dll_scheme_read
413# define scheme_register_static dll_scheme_register_static
414# define scheme_set_stack_base dll_scheme_set_stack_base
415# define scheme_signal_error dll_scheme_signal_error
416# define scheme_wrong_type dll_scheme_wrong_type
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000417# if MZSCHEME_VERSION_MAJOR >= 299
418# define scheme_set_param dll_scheme_set_param
419# define scheme_current_config dll_scheme_current_config
420# define scheme_char_string_to_byte_string \
421 dll_scheme_char_string_to_byte_string
Bram Moolenaare2a49d82007-07-06 17:43:08 +0000422# define scheme_char_string_to_path \
423 dll_scheme_char_string_to_path
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000424# endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000425# define scheme_make_hash_table dll_scheme_make_hash_table
426# define scheme_hash_set dll_scheme_hash_set
427# define scheme_hash_get dll_scheme_hash_get
428# define scheme_make_double dll_scheme_make_double
429# ifdef INCLUDE_MZSCHEME_BASE
430# define scheme_make_sized_byte_string dll_scheme_make_sized_byte_string
431# define scheme_namespace_require dll_scheme_namespace_require
432# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000433
434typedef struct
435{
436 char *name;
437 void **ptr;
438} Thunk_Info;
439
440static Thunk_Info mzgc_imports[] = {
441 {"GC_malloc", (void **)&dll_GC_malloc},
442 {"GC_malloc_atomic", (void **)&dll_GC_malloc_atomic},
443 {NULL, NULL}};
444
445static Thunk_Info mzsch_imports[] = {
446 {"scheme_eof", (void **)&dll_scheme_eof},
447 {"scheme_false", (void **)&dll_scheme_false},
448 {"scheme_void", (void **)&dll_scheme_void},
449 {"scheme_null", (void **)&dll_scheme_null},
450 {"scheme_true", (void **)&dll_scheme_true},
451 {"scheme_current_thread", (void **)&dll_scheme_current_thread_ptr},
452 {"scheme_console_printf", (void **)&dll_scheme_console_printf_ptr},
453 {"scheme_console_output", (void **)&dll_scheme_console_output_ptr},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000454 {"scheme_notify_multithread",
Bram Moolenaar33570922005-01-25 22:26:29 +0000455 (void **)&dll_scheme_notify_multithread_ptr},
456 {"scheme_add_global", (void **)&dll_scheme_add_global},
457 {"scheme_add_global_symbol", (void **)&dll_scheme_add_global_symbol},
458 {"scheme_apply", (void **)&dll_scheme_apply},
459 {"scheme_basic_env", (void **)&dll_scheme_basic_env},
Bram Moolenaar555b2802005-05-19 21:08:39 +0000460# if MZSCHEME_VERSION_MAJOR >= 299
461 {"scheme_byte_string_to_char_string", (void **)&dll_scheme_byte_string_to_char_string},
462# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000463 {"scheme_builtin_value", (void **)&dll_scheme_builtin_value},
464 {"scheme_check_threads", (void **)&dll_scheme_check_threads},
465 {"scheme_close_input_port", (void **)&dll_scheme_close_input_port},
466 {"scheme_count_lines", (void **)&dll_scheme_count_lines},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000467 {"scheme_current_continuation_marks",
Bram Moolenaar33570922005-01-25 22:26:29 +0000468 (void **)&dll_scheme_current_continuation_marks},
469 {"scheme_display", (void **)&dll_scheme_display},
470 {"scheme_display_to_string", (void **)&dll_scheme_display_to_string},
471 {"scheme_do_eval", (void **)&dll_scheme_do_eval},
472 {"scheme_dont_gc_ptr", (void **)&dll_scheme_dont_gc_ptr},
Bram Moolenaar555b2802005-05-19 21:08:39 +0000473 {"scheme_eq", (void **)&dll_scheme_eq},
Bram Moolenaar33570922005-01-25 22:26:29 +0000474 {"scheme_eval", (void **)&dll_scheme_eval},
475 {"scheme_eval_string", (void **)&dll_scheme_eval_string},
476 {"scheme_eval_string_all", (void **)&dll_scheme_eval_string_all},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000477 {"scheme_finish_primitive_module",
Bram Moolenaar33570922005-01-25 22:26:29 +0000478 (void **)&dll_scheme_finish_primitive_module},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000479# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar33570922005-01-25 22:26:29 +0000480 {"scheme_format", (void **)&dll_scheme_format},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000481# else
482 {"scheme_format_utf8", (void **)&dll_scheme_format_utf8},
Bram Moolenaar555b2802005-05-19 21:08:39 +0000483 {"scheme_get_param", (void **)&dll_scheme_get_param},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000484#endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000485 {"scheme_gc_ptr_ok", (void **)&dll_scheme_gc_ptr_ok},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000486# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000487 {"scheme_get_sized_string_output",
Bram Moolenaar33570922005-01-25 22:26:29 +0000488 (void **)&dll_scheme_get_sized_string_output},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000489# else
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000490 {"scheme_get_sized_byte_string_output",
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000491 (void **)&dll_scheme_get_sized_byte_string_output},
492#endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000493 {"scheme_intern_symbol", (void **)&dll_scheme_intern_symbol},
494 {"scheme_lookup_global", (void **)&dll_scheme_lookup_global},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000495 {"scheme_make_closed_prim_w_arity",
Bram Moolenaar33570922005-01-25 22:26:29 +0000496 (void **)&dll_scheme_make_closed_prim_w_arity},
497 {"scheme_make_integer_value", (void **)&dll_scheme_make_integer_value},
Bram Moolenaar33570922005-01-25 22:26:29 +0000498 {"scheme_make_pair", (void **)&dll_scheme_make_pair},
Bram Moolenaar555b2802005-05-19 21:08:39 +0000499 {"scheme_make_prim_w_arity", (void **)&dll_scheme_make_prim_w_arity},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000500# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar33570922005-01-25 22:26:29 +0000501 {"scheme_make_string", (void **)&dll_scheme_make_string},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000502 {"scheme_make_string_output_port",
Bram Moolenaar33570922005-01-25 22:26:29 +0000503 (void **)&dll_scheme_make_string_output_port},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000504# else
505 {"scheme_make_byte_string", (void **)&dll_scheme_make_byte_string},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000506 {"scheme_make_byte_string_output_port",
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000507 (void **)&dll_scheme_make_byte_string_output_port},
508# endif
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000509 {"scheme_make_struct_instance",
Bram Moolenaar33570922005-01-25 22:26:29 +0000510 (void **)&dll_scheme_make_struct_instance},
511 {"scheme_make_struct_names", (void **)&dll_scheme_make_struct_names},
512 {"scheme_make_struct_type", (void **)&dll_scheme_make_struct_type},
513 {"scheme_make_struct_values", (void **)&dll_scheme_make_struct_values},
514 {"scheme_make_type", (void **)&dll_scheme_make_type},
515 {"scheme_make_vector", (void **)&dll_scheme_make_vector},
516 {"scheme_malloc_fail_ok", (void **)&dll_scheme_malloc_fail_ok},
517 {"scheme_open_input_file", (void **)&dll_scheme_open_input_file},
518 {"scheme_primitive_module", (void **)&dll_scheme_primitive_module},
519 {"scheme_proper_list_length", (void **)&dll_scheme_proper_list_length},
520 {"scheme_raise", (void **)&dll_scheme_raise},
521 {"scheme_read", (void **)&dll_scheme_read},
522 {"scheme_register_static", (void **)&dll_scheme_register_static},
523 {"scheme_set_stack_base", (void **)&dll_scheme_set_stack_base},
524 {"scheme_signal_error", (void **)&dll_scheme_signal_error},
525 {"scheme_wrong_type", (void **)&dll_scheme_wrong_type},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000526# if MZSCHEME_VERSION_MAJOR >= 299
527 {"scheme_set_param", (void **)&dll_scheme_set_param},
528 {"scheme_current_config", (void **)&dll_scheme_current_config},
529 {"scheme_char_string_to_byte_string",
530 (void **)&dll_scheme_char_string_to_byte_string},
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000531 {"scheme_char_string_to_path", (void **)&dll_scheme_char_string_to_path},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000532# endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000533 {"scheme_make_hash_table", (void **)&dll_scheme_make_hash_table},
534 {"scheme_hash_set", (void **)&dll_scheme_hash_set},
535 {"scheme_hash_get", (void **)&dll_scheme_hash_get},
536 {"scheme_make_double", (void **)&dll_scheme_make_double},
537# ifdef INCLUDE_MZSCHEME_BASE
538 {"scheme_make_sized_byte_string", (void **)&dll_scheme_make_sized_byte_string},
539 {"scheme_namespace_require", (void **)&dll_scheme_namespace_require},
540#endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000541 {NULL, NULL}};
542
543static HINSTANCE hMzGC = 0;
544static HINSTANCE hMzSch = 0;
545
546static void dynamic_mzscheme_end(void);
547static int mzscheme_runtime_link_init(char *sch_dll, char *gc_dll,
548 int verbose);
549
550 static int
551mzscheme_runtime_link_init(char *sch_dll, char *gc_dll, int verbose)
552{
553 Thunk_Info *thunk = NULL;
554
555 if (hMzGC && hMzSch)
556 return OK;
Bram Moolenaarebbcb822010-10-23 14:02:54 +0200557 hMzSch = vimLoadLib(sch_dll);
558 hMzGC = vimLoadLib(gc_dll);
Bram Moolenaar33570922005-01-25 22:26:29 +0000559
Bram Moolenaar33570922005-01-25 22:26:29 +0000560 if (!hMzGC)
561 {
562 if (verbose)
563 EMSG2(_(e_loadlib), gc_dll);
564 return FAIL;
565 }
566
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100567 if (!hMzSch)
568 {
569 if (verbose)
570 EMSG2(_(e_loadlib), sch_dll);
571 return FAIL;
572 }
573
Bram Moolenaar33570922005-01-25 22:26:29 +0000574 for (thunk = mzsch_imports; thunk->name; thunk++)
575 {
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000576 if ((*thunk->ptr =
Bram Moolenaar33570922005-01-25 22:26:29 +0000577 (void *)GetProcAddress(hMzSch, thunk->name)) == NULL)
578 {
579 FreeLibrary(hMzSch);
580 hMzSch = 0;
581 FreeLibrary(hMzGC);
582 hMzGC = 0;
583 if (verbose)
584 EMSG2(_(e_loadfunc), thunk->name);
585 return FAIL;
586 }
587 }
588 for (thunk = mzgc_imports; thunk->name; thunk++)
589 {
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000590 if ((*thunk->ptr =
Bram Moolenaar33570922005-01-25 22:26:29 +0000591 (void *)GetProcAddress(hMzGC, thunk->name)) == NULL)
592 {
593 FreeLibrary(hMzSch);
594 hMzSch = 0;
595 FreeLibrary(hMzGC);
596 hMzGC = 0;
597 if (verbose)
598 EMSG2(_(e_loadfunc), thunk->name);
599 return FAIL;
600 }
601 }
602 return OK;
603}
604
605 int
606mzscheme_enabled(int verbose)
607{
608 return mzscheme_runtime_link_init(
609 DYNAMIC_MZSCH_DLL, DYNAMIC_MZGC_DLL, verbose) == OK;
610}
611
612 static void
613dynamic_mzscheme_end(void)
614{
615 if (hMzSch)
616 {
617 FreeLibrary(hMzSch);
618 hMzSch = 0;
619 }
620 if (hMzGC)
621 {
622 FreeLibrary(hMzGC);
623 hMzGC = 0;
624 }
625}
626#endif /* DYNAMIC_MZSCHEME */
627
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000628/* need to put it here for dynamic stuff to work */
Bram Moolenaare484c942009-09-11 10:21:41 +0000629#if defined(INCLUDE_MZSCHEME_BASE)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000630# include "mzscheme_base.c"
Bram Moolenaare484c942009-09-11 10:21:41 +0000631#elif MZSCHEME_VERSION_MAJOR >= 400
632# error MzScheme 4.x must include mzscheme_base.c, for MinGW32 you need to define MZSCHEME_GENERATE_BASE=yes
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000633#endif
634
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000635/*
636 *========================================================================
637 * 1. MzScheme interpreter startup
638 *========================================================================
639 */
640
641static Scheme_Type mz_buffer_type;
642static Scheme_Type mz_window_type;
643
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000644static int initialized = FALSE;
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000645
646/* global environment */
647static Scheme_Env *environment = NULL;
648/* output/error handlers */
649static Scheme_Object *curout = NULL;
650static Scheme_Object *curerr = NULL;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000651/* exn:vim exception */
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000652static Scheme_Object *exn_catching_apply = NULL;
653static Scheme_Object *exn_p = NULL;
654static Scheme_Object *exn_message = NULL;
655static Scheme_Object *vim_exn = NULL; /* Vim Error exception */
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000656
657#if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400
658static void *stack_base = NULL;
659#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000660
661static long range_start;
662static long range_end;
663
664/* MzScheme threads scheduling stuff */
665static int mz_threads_allow = 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000666
667#if defined(FEAT_GUI_W32)
668static void CALLBACK timer_proc(HWND, UINT, UINT, DWORD);
669static UINT timer_id = 0;
670#elif defined(FEAT_GUI_GTK)
671static gint timer_proc(gpointer);
672static guint timer_id = 0;
673#elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA)
674static void timer_proc(XtPointer, XtIntervalId *);
675static XtIntervalId timer_id = (XtIntervalId)0;
676#elif defined(FEAT_GUI_MAC)
677pascal void timer_proc(EventLoopTimerRef, void *);
678static EventLoopTimerRef timer_id = NULL;
679static EventLoopTimerUPP timerUPP;
680#endif
681
682#ifndef FEAT_GUI_W32 /* Win32 console and Unix */
683 void
684mzvim_check_threads(void)
685{
686 /* Last time MzScheme threads were scheduled */
687 static time_t mz_last_time = 0;
688
689 if (mz_threads_allow && p_mzq > 0)
690 {
691 time_t now = time(NULL);
692
693 if ((now - mz_last_time) * 1000 > p_mzq)
694 {
695 mz_last_time = now;
696 scheme_check_threads();
697 }
698 }
699}
700#endif
701
Bram Moolenaar2df6dcc2004-07-12 15:53:54 +0000702#ifdef MZSCHEME_GUI_THREADS
703static void setup_timer(void);
704static void remove_timer(void);
705
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000706/* timers are presented in GUI only */
707# if defined(FEAT_GUI_W32)
708 static void CALLBACK
Bram Moolenaar64404472010-06-26 06:24:45 +0200709timer_proc(HWND hwnd UNUSED, UINT uMsg UNUSED, UINT idEvent UNUSED, DWORD dwTime UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000710# elif defined(FEAT_GUI_GTK)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000711 static gint
Bram Moolenaar64404472010-06-26 06:24:45 +0200712timer_proc(gpointer data UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000713# elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000714 static void
Bram Moolenaar64404472010-06-26 06:24:45 +0200715timer_proc(XtPointer timed_out UNUSED, XtIntervalId *interval_id UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000716# elif defined(FEAT_GUI_MAC)
717 pascal void
Bram Moolenaar64404472010-06-26 06:24:45 +0200718timer_proc(EventLoopTimerRef theTimer UNUSED, void *userData UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000719# endif
720{
721 scheme_check_threads();
722# if defined(FEAT_GUI_GTK)
723 return TRUE; /* continue receiving notifications */
724# elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA)
725 /* renew timeout */
726 if (mz_threads_allow && p_mzq > 0)
727 timer_id = XtAppAddTimeOut(app_context, p_mzq,
728 timer_proc, NULL);
729# endif
730}
731
732 static void
733setup_timer(void)
734{
735# if defined(FEAT_GUI_W32)
736 timer_id = SetTimer(NULL, 0, p_mzq, timer_proc);
737# elif defined(FEAT_GUI_GTK)
738 timer_id = gtk_timeout_add((guint32)p_mzq, (GtkFunction)timer_proc, NULL);
739# elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA)
740 timer_id = XtAppAddTimeOut(app_context, p_mzq, timer_proc, NULL);
741# elif defined(FEAT_GUI_MAC)
742 timerUPP = NewEventLoopTimerUPP(timer_proc);
743 InstallEventLoopTimer(GetMainEventLoop(), p_mzq * kEventDurationMillisecond,
744 p_mzq * kEventDurationMillisecond, timerUPP, NULL, &timer_id);
745# endif
746}
747
748 static void
749remove_timer(void)
750{
751# if defined(FEAT_GUI_W32)
752 KillTimer(NULL, timer_id);
753# elif defined(FEAT_GUI_GTK)
754 gtk_timeout_remove(timer_id);
755# elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA)
756 XtRemoveTimeOut(timer_id);
757# elif defined(FEAT_GUI_MAC)
758 RemoveEventLoopTimer(timer_id);
759 DisposeEventLoopTimerUPP(timerUPP);
760# endif
761 timer_id = 0;
762}
763
764 void
765mzvim_reset_timer(void)
766{
767 if (timer_id != 0)
768 remove_timer();
769 if (mz_threads_allow && p_mzq > 0 && gui.in_use)
770 setup_timer();
771}
772
Bram Moolenaar2df6dcc2004-07-12 15:53:54 +0000773#endif /* MZSCHEME_GUI_THREADS */
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000774
775 static void
776notify_multithread(int on)
777{
778 mz_threads_allow = on;
Bram Moolenaar2df6dcc2004-07-12 15:53:54 +0000779#ifdef MZSCHEME_GUI_THREADS
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000780 if (on && timer_id == 0 && p_mzq > 0 && gui.in_use)
781 setup_timer();
782 if (!on && timer_id != 0)
783 remove_timer();
784#endif
785}
786
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000787 void
788mzscheme_end(void)
789{
Bram Moolenaar33570922005-01-25 22:26:29 +0000790#ifdef DYNAMIC_MZSCHEME
791 dynamic_mzscheme_end();
792#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000793}
794
Bram Moolenaar2d0860d2010-11-03 21:59:30 +0100795#if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) && defined(USE_THREAD_LOCAL)
796static __declspec(thread) void *tls_space;
797#endif
798
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100799/*
800 * Since version 4.x precise GC requires trampolined startup.
801 * Futures and places in version 5.x need it too.
802 */
803#if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 \
804 || MZSCHEME_VERSION_MAJOR >= 500 && (defined(MZ_USE_FUTURES) || defined(MZ_USE_PLACES))
805# ifdef DYNAMIC_MZSCHEME
806# error Precise GC v.4+ or Racket with futures/places do not support dynamic MzScheme
807# endif
808# define TRAMPOLINED_MZVIM_STARTUP
809#endif
810
811 int
812mzscheme_main(int argc, char** argv)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000813{
Bram Moolenaar2d0860d2010-11-03 21:59:30 +0100814#if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) && defined(USE_THREAD_LOCAL)
815 scheme_register_tls_space(&tls_space, 0);
816#endif
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100817#ifdef TRAMPOLINED_MZVIM_STARTUP
818 return scheme_main_setup(TRUE, mzscheme_env_main, argc, argv);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000819#else
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100820 return mzscheme_env_main(NULL, argc, argv);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000821#endif
822}
823
824 static int
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100825mzscheme_env_main(Scheme_Env *env, int argc, char **argv)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000826{
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100827 int vim_main_result;
828#ifdef TRAMPOLINED_MZVIM_STARTUP
829 /* Scheme has created the environment for us */
830 environment = env;
831#else
832# ifdef MZ_PRECISE_GC
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000833 Scheme_Object *dummy = NULL;
834 MZ_GC_DECL_REG(1);
835 MZ_GC_VAR_IN_REG(0, dummy);
836
837 stack_base = &__gc_var_stack__;
838# else
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000839 int dummy = 0;
840 stack_base = (void *)&dummy;
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100841# endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000842#endif
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100843
844 /* mzscheme_main is called as a trampoline from main.
845 * We trampoline into vim_main2
846 * Passing argc, argv through from mzscheme_main
847 */
848 vim_main_result = vim_main2(argc, argv);
849#if !defined(TRAMPOLINED_MZVIM_STARTUP) && defined(MZ_PRECISE_GC)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000850 /* releasing dummy */
851 MZ_GC_REG();
852 MZ_GC_UNREG();
853#endif
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100854 return vim_main_result;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000855}
856
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000857 static void
858startup_mzscheme(void)
859{
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100860#ifndef TRAMPOLINED_MZVIM_STARTUP
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000861 scheme_set_stack_base(stack_base, 1);
862#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000863
864 MZ_REGISTER_STATIC(environment);
865 MZ_REGISTER_STATIC(curout);
866 MZ_REGISTER_STATIC(curerr);
867 MZ_REGISTER_STATIC(exn_catching_apply);
868 MZ_REGISTER_STATIC(exn_p);
869 MZ_REGISTER_STATIC(exn_message);
870 MZ_REGISTER_STATIC(vim_exn);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000871
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100872#ifndef TRAMPOLINED_MZVIM_STARTUP
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000873 /* in newer versions of precise GC the initial env has been created */
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000874 environment = scheme_basic_env();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000875#endif
876 MZ_GC_CHECK();
877
878#ifdef INCLUDE_MZSCHEME_BASE
879 {
880 /*
Bram Moolenaare484c942009-09-11 10:21:41 +0000881 * versions 4.x do not provide Scheme bindings by default
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000882 * we need to add them explicitly
883 */
884 Scheme_Object *scheme_base_symbol = NULL;
885 MZ_GC_DECL_REG(1);
886 MZ_GC_VAR_IN_REG(0, scheme_base_symbol);
887 MZ_GC_REG();
Bram Moolenaare484c942009-09-11 10:21:41 +0000888 /* invoke function from generated and included mzscheme_base.c */
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000889 declare_modules(environment);
890 scheme_base_symbol = scheme_intern_symbol("scheme/base");
891 MZ_GC_CHECK();
892 scheme_namespace_require(scheme_base_symbol);
893 MZ_GC_CHECK();
894 MZ_GC_UNREG();
895 }
896#endif
897 register_vim_exn();
898 /* use new environment to initialise exception handling */
899 init_exn_catching_apply();
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000900
901 /* redirect output */
902 scheme_console_output = do_output;
903 scheme_console_printf = do_printf;
904
905#ifdef MZSCHEME_COLLECTS
906 /* setup 'current-library-collection-paths' parameter */
Bram Moolenaare2a49d82007-07-06 17:43:08 +0000907# if MZSCHEME_VERSION_MAJOR >= 299
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000908 {
909 Scheme_Object *coll_byte_string = NULL;
910 Scheme_Object *coll_char_string = NULL;
911 Scheme_Object *coll_path = NULL;
912 Scheme_Object *coll_pair = NULL;
913 Scheme_Config *config = NULL;
914
915 MZ_GC_DECL_REG(5);
916 MZ_GC_VAR_IN_REG(0, coll_byte_string);
917 MZ_GC_VAR_IN_REG(1, coll_char_string);
918 MZ_GC_VAR_IN_REG(2, coll_path);
919 MZ_GC_VAR_IN_REG(3, coll_pair);
920 MZ_GC_VAR_IN_REG(4, config);
921 MZ_GC_REG();
922 coll_byte_string = scheme_make_byte_string(MZSCHEME_COLLECTS);
923 MZ_GC_CHECK();
924 coll_char_string = scheme_byte_string_to_char_string(coll_byte_string);
925 MZ_GC_CHECK();
926 coll_path = scheme_char_string_to_path(coll_char_string);
927 MZ_GC_CHECK();
928 coll_pair = scheme_make_pair(coll_path, scheme_null);
929 MZ_GC_CHECK();
930 config = scheme_config;
931 MZ_GC_CHECK();
932 scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair);
933 MZ_GC_CHECK();
934 MZ_GC_UNREG();
935 }
Bram Moolenaare2a49d82007-07-06 17:43:08 +0000936# else
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000937 {
938 Scheme_Object *coll_string = NULL;
939 Scheme_Object *coll_pair = NULL;
940 Scheme_Config *config = NULL;
941
942 MZ_GC_DECL_REG(3);
943 MZ_GC_VAR_IN_REG(0, coll_string);
944 MZ_GC_VAR_IN_REG(1, coll_pair);
945 MZ_GC_VAR_IN_REG(2, config);
946 MZ_GC_REG();
947 coll_string = scheme_make_string(MZSCHEME_COLLECTS);
948 MZ_GC_CHECK();
949 coll_pair = scheme_make_pair(coll_string, scheme_null);
950 MZ_GC_CHECK();
951 config = scheme_config;
952 MZ_GC_CHECK();
953 scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair);
954 MZ_GC_CHECK();
955 MZ_GC_UNREG();
956 }
Bram Moolenaare2a49d82007-07-06 17:43:08 +0000957# endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000958#endif
Bram Moolenaar555b2802005-05-19 21:08:39 +0000959#ifdef HAVE_SANDBOX
Bram Moolenaar555b2802005-05-19 21:08:39 +0000960 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000961 Scheme_Object *make_security_guard = NULL;
962 MZ_GC_DECL_REG(1);
963 MZ_GC_VAR_IN_REG(0, make_security_guard);
964 MZ_GC_REG();
965
966#if MZSCHEME_VERSION_MAJOR < 400
967 {
968 Scheme_Object *make_security_guard_symbol = NULL;
969 MZ_GC_DECL_REG(1);
970 MZ_GC_VAR_IN_REG(0, make_security_guard_symbol);
971 MZ_GC_REG();
972 make_security_guard_symbol = scheme_intern_symbol("make-security-guard");
973 MZ_GC_CHECK();
974 make_security_guard = scheme_lookup_global(
975 make_security_guard_symbol, environment);
976 MZ_GC_UNREG();
977 }
978#else
979 make_security_guard = scheme_builtin_value("make-security-guard");
980 MZ_GC_CHECK();
981#endif
982
983 /* setup sandbox guards */
984 if (make_security_guard != NULL)
985 {
986 Scheme_Object *args[3] = {NULL, NULL, NULL};
987 Scheme_Object *guard = NULL;
988 Scheme_Config *config = NULL;
989 MZ_GC_DECL_REG(5);
990 MZ_GC_ARRAY_VAR_IN_REG(0, args, 3);
991 MZ_GC_VAR_IN_REG(3, guard);
992 MZ_GC_VAR_IN_REG(4, config);
993 MZ_GC_REG();
994 config = scheme_config;
995 MZ_GC_CHECK();
996 args[0] = scheme_get_param(config, MZCONFIG_SECURITY_GUARD);
997 MZ_GC_CHECK();
998 args[1] = scheme_make_prim_w_arity(sandbox_file_guard,
999 "sandbox-file-guard", 3, 3);
1000 args[2] = scheme_make_prim_w_arity(sandbox_network_guard,
1001 "sandbox-network-guard", 4, 4);
1002 guard = scheme_apply(make_security_guard, 3, args);
1003 MZ_GC_CHECK();
1004 scheme_set_param(config, MZCONFIG_SECURITY_GUARD, guard);
1005 MZ_GC_CHECK();
1006 MZ_GC_UNREG();
1007 }
1008 MZ_GC_UNREG();
Bram Moolenaar555b2802005-05-19 21:08:39 +00001009 }
1010#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001011 /* Create buffer and window types for use in Scheme code */
1012 mz_buffer_type = scheme_make_type("<vim-buffer>");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001013 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001014 mz_window_type = scheme_make_type("<vim-window>");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001015 MZ_GC_CHECK();
1016#ifdef MZ_PRECISE_GC
1017 GC_register_traversers(mz_buffer_type,
1018 buffer_size_proc, buffer_mark_proc, buffer_fixup_proc,
1019 TRUE, TRUE);
1020 GC_register_traversers(mz_window_type,
1021 window_size_proc, window_mark_proc, window_fixup_proc,
1022 TRUE, TRUE);
1023#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001024
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001025 make_modules();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001026
1027 /*
1028 * setup callback to receive notifications
1029 * whether thread scheduling is (or not) required
1030 */
1031 scheme_notify_multithread = notify_multithread;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001032}
1033
1034/*
1035 * This routine is called for each new invocation of MzScheme
1036 * to make sure things are properly initialized.
1037 */
1038 static int
1039mzscheme_init(void)
1040{
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001041 if (!initialized)
1042 {
Bram Moolenaar33570922005-01-25 22:26:29 +00001043#ifdef DYNAMIC_MZSCHEME
1044 if (!mzscheme_enabled(TRUE))
1045 {
Bram Moolenaarb849e712009-06-24 15:51:37 +00001046 EMSG(_("E815: Sorry, this command is disabled, the MzScheme libraries could not be loaded."));
Bram Moolenaar33570922005-01-25 22:26:29 +00001047 return -1;
1048 }
1049#endif
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001050 startup_mzscheme();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001051 initialized = TRUE;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001052 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001053 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001054 Scheme_Config *config = NULL;
1055 MZ_GC_DECL_REG(1);
1056 MZ_GC_VAR_IN_REG(0, config);
1057 MZ_GC_REG();
1058 config = scheme_config;
1059 MZ_GC_CHECK();
Bram Moolenaar0a1c0ec2009-12-16 18:02:47 +00001060 /* recreate ports each call effectively clearing these ones */
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001061 curout = scheme_make_string_output_port();
1062 MZ_GC_CHECK();
1063 curerr = scheme_make_string_output_port();
1064 MZ_GC_CHECK();
1065 scheme_set_param(config, MZCONFIG_OUTPUT_PORT, curout);
1066 MZ_GC_CHECK();
1067 scheme_set_param(config, MZCONFIG_ERROR_PORT, curerr);
1068 MZ_GC_CHECK();
1069 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001070 }
1071
1072 return 0;
1073}
1074
1075/*
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001076 *========================================================================
1077 * 2. External Interface
1078 *========================================================================
1079 */
1080
1081/*
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001082 * Evaluate command with exception handling
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001083 */
1084 static int
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001085eval_with_exn_handling(void *data, Scheme_Closed_Prim *what, Scheme_Object **ret)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001086{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001087 Scheme_Object *value = NULL;
1088 Scheme_Object *exn = NULL;
1089 Scheme_Object *prim = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001090
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001091 MZ_GC_DECL_REG(3);
1092 MZ_GC_VAR_IN_REG(0, value);
1093 MZ_GC_VAR_IN_REG(1, exn);
1094 MZ_GC_VAR_IN_REG(2, prim);
1095 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001096
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001097 prim = scheme_make_closed_prim_w_arity(what, data, "mzvim", 0, 0);
1098 MZ_GC_CHECK();
1099 value = _apply_thunk_catch_exceptions(prim, &exn);
1100 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001101
1102 if (!value)
1103 {
1104 value = extract_exn_message(exn);
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001105 /* Got an exn? */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001106 if (value)
1107 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001108 scheme_display(value, curerr); /* Send to stderr-vim */
1109 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001110 do_flush();
1111 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001112 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001113 /* `raise' was called on some arbitrary value */
1114 return FAIL;
1115 }
1116
1117 if (ret != NULL) /* if pointer to retval supported give it up */
1118 *ret = value;
1119 /* Print any result, as long as it's not a void */
1120 else if (!SCHEME_VOIDP(value))
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001121 {
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001122 scheme_display(value, curout); /* Send to stdout-vim */
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001123 MZ_GC_CHECK();
1124 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001125
1126 do_flush();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001127 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001128 return OK;
1129}
1130
1131/* :mzscheme */
1132 static int
1133do_mzscheme_command(exarg_T *eap, void *data, Scheme_Closed_Prim *what)
1134{
1135 if (mzscheme_init())
1136 return FAIL;
1137
1138 range_start = eap->line1;
1139 range_end = eap->line2;
1140
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001141 return eval_with_exn_handling(data, what, NULL);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001142}
1143
1144/*
1145 * Routine called by VIM when deleting a buffer
1146 */
1147 void
1148mzscheme_buffer_free(buf_T *buf)
1149{
Bram Moolenaare344bea2005-09-01 20:46:49 +00001150 if (buf->b_mzscheme_ref)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001151 {
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001152 vim_mz_buffer *bp;
1153
Bram Moolenaare344bea2005-09-01 20:46:49 +00001154 bp = buf->b_mzscheme_ref;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001155 bp->buf = INVALID_BUFFER_VALUE;
Bram Moolenaare344bea2005-09-01 20:46:49 +00001156 buf->b_mzscheme_ref = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001157 scheme_gc_ptr_ok(bp);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001158 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001159 }
1160}
1161
1162/*
1163 * Routine called by VIM when deleting a Window
1164 */
1165 void
1166mzscheme_window_free(win_T *win)
1167{
Bram Moolenaare344bea2005-09-01 20:46:49 +00001168 if (win->w_mzscheme_ref)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001169 {
1170 vim_mz_window *wp;
Bram Moolenaare344bea2005-09-01 20:46:49 +00001171 wp = win->w_mzscheme_ref;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001172 wp->win = INVALID_WINDOW_VALUE;
Bram Moolenaare344bea2005-09-01 20:46:49 +00001173 win->w_mzscheme_ref = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001174 scheme_gc_ptr_ok(wp);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001175 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001176 }
1177}
1178
1179/*
1180 * ":mzscheme" (or ":mz")
1181 */
1182 void
1183ex_mzscheme(exarg_T *eap)
1184{
1185 char_u *script;
1186
1187 script = script_get(eap, eap->arg);
1188 if (!eap->skip)
1189 {
1190 if (script == NULL)
1191 do_mzscheme_command(eap, eap->arg, do_eval);
1192 else
1193 {
1194 do_mzscheme_command(eap, script, do_eval);
1195 vim_free(script);
1196 }
1197 }
1198}
1199
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001200 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001201do_load(void *data, int noargc UNUSED, Scheme_Object **noargv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001202{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001203 Scheme_Object *expr = NULL;
1204 Scheme_Object *result = NULL;
1205 char *file = NULL;
1206 Port_Info *pinfo = (Port_Info *)data;
1207
1208 MZ_GC_DECL_REG(3);
1209 MZ_GC_VAR_IN_REG(0, expr);
1210 MZ_GC_VAR_IN_REG(1, result);
1211 MZ_GC_VAR_IN_REG(2, file);
1212 MZ_GC_REG();
1213
1214 file = (char *)scheme_malloc_fail_ok(scheme_malloc_atomic, MAXPATHL + 1);
1215 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001216
1217 /* make Vim expansion */
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001218 expand_env((char_u *)pinfo->name, (char_u *)file, MAXPATHL);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001219 pinfo->port = scheme_open_input_file(file, "mzfile");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001220 MZ_GC_CHECK();
1221 scheme_count_lines(pinfo->port); /* to get accurate read error location*/
1222 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001223
1224 /* Like REPL but print only last result */
1225 while (!SCHEME_EOFP(expr = scheme_read(pinfo->port)))
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001226 {
1227 result = scheme_eval(expr, environment);
1228 MZ_GC_CHECK();
1229 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001230
Bram Moolenaar0a1c0ec2009-12-16 18:02:47 +00001231 /* errors will be caught in do_mzscheme_command and ex_mzfile */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001232 scheme_close_input_port(pinfo->port);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001233 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001234 pinfo->port = NULL;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001235 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001236 return result;
1237}
1238
1239/* :mzfile */
1240 void
1241ex_mzfile(exarg_T *eap)
1242{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001243 Port_Info pinfo = {NULL, NULL};
1244
1245 MZ_GC_DECL_REG(1);
1246 MZ_GC_VAR_IN_REG(0, pinfo.port);
1247 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001248
1249 pinfo.name = (char *)eap->arg;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001250 if (do_mzscheme_command(eap, &pinfo, do_load) != OK
1251 && pinfo.port != NULL) /* looks like port was not closed */
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001252 {
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001253 scheme_close_input_port(pinfo.port);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001254 MZ_GC_CHECK();
1255 }
1256 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001257}
1258
1259
1260/*
1261 *========================================================================
1262 * Exception handling code -- cribbed form the MzScheme sources and
1263 * Matthew Flatt's "Inside PLT MzScheme" document.
1264 *========================================================================
1265 */
1266 static void
1267init_exn_catching_apply(void)
1268{
1269 if (!exn_catching_apply)
1270 {
1271 char *e =
1272 "(lambda (thunk) "
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001273 "(with-handlers ([void (lambda (exn) (cons #f exn))]) "
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001274 "(cons #t (thunk))))";
1275
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001276 exn_catching_apply = scheme_eval_string(e, environment);
1277 MZ_GC_CHECK();
1278 exn_p = scheme_builtin_value("exn?");
1279 MZ_GC_CHECK();
1280 exn_message = scheme_builtin_value("exn-message");
1281 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001282 }
1283}
1284
1285/*
1286 * This function applies a thunk, returning the Scheme value if there's
1287 * no exception, otherwise returning NULL and setting *exn to the raised
1288 * value (usually an exn structure).
1289 */
1290 static Scheme_Object *
1291_apply_thunk_catch_exceptions(Scheme_Object *f, Scheme_Object **exn)
1292{
1293 Scheme_Object *v;
1294
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001295 v = _scheme_apply(exn_catching_apply, 1, &f);
1296 /* v is a pair: (cons #t value) or (cons #f exn) */
1297
1298 if (SCHEME_TRUEP(SCHEME_CAR(v)))
1299 return SCHEME_CDR(v);
1300 else
1301 {
1302 *exn = SCHEME_CDR(v);
1303 return NULL;
1304 }
1305}
1306
1307 static Scheme_Object *
1308extract_exn_message(Scheme_Object *v)
1309{
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001310 if (SCHEME_TRUEP(_scheme_apply(exn_p, 1, &v)))
1311 return _scheme_apply(exn_message, 1, &v);
1312 else
1313 return NULL; /* Not an exn structure */
1314}
1315
1316 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001317do_eval(void *s, int noargc UNUSED, Scheme_Object **noargv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001318{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001319 return scheme_eval_string_all((char *)s, environment, TRUE);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001320}
1321
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001322/*
1323 *========================================================================
1324 * 3. MzScheme I/O Handlers
1325 *========================================================================
1326 */
1327 static void
Bram Moolenaar64404472010-06-26 06:24:45 +02001328do_intrnl_output(char *mesg, int error)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001329{
1330 char *p, *prev;
1331
1332 prev = mesg;
1333 p = strchr(prev, '\n');
1334 while (p)
1335 {
1336 *p = '\0';
1337 if (error)
1338 EMSG(prev);
1339 else
1340 MSG(prev);
1341 prev = p + 1;
1342 p = strchr(prev, '\n');
1343 }
1344
1345 if (error)
1346 EMSG(prev);
1347 else
1348 MSG(prev);
1349}
1350
1351 static void
Bram Moolenaar64404472010-06-26 06:24:45 +02001352do_output(char *mesg, long len UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001353{
Bram Moolenaar64404472010-06-26 06:24:45 +02001354 do_intrnl_output(mesg, 0);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001355}
1356
1357 static void
Bram Moolenaar64404472010-06-26 06:24:45 +02001358do_err_output(char *mesg)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001359{
Bram Moolenaar64404472010-06-26 06:24:45 +02001360 do_intrnl_output(mesg, 1);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001361}
1362
1363 static void
1364do_printf(char *format, ...)
1365{
Bram Moolenaar64404472010-06-26 06:24:45 +02001366 do_intrnl_output(format, 1);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001367}
1368
1369 static void
1370do_flush(void)
1371{
1372 char *buff;
1373 long length;
1374
1375 buff = scheme_get_sized_string_output(curerr, &length);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001376 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001377 if (length)
1378 {
Bram Moolenaar64404472010-06-26 06:24:45 +02001379 do_err_output(buff);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001380 return;
1381 }
1382
1383 buff = scheme_get_sized_string_output(curout, &length);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001384 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001385 if (length)
1386 do_output(buff, length);
1387}
1388
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001389/*
1390 *========================================================================
1391 * 4. Implementation of the Vim Features for MzScheme
1392 *========================================================================
1393 */
1394
1395/* (command {command-string}) */
1396 static Scheme_Object *
1397vim_command(void *data, int argc, Scheme_Object **argv)
1398{
1399 Vim_Prim *prim = (Vim_Prim *)data;
1400 char *cmd = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0));
1401
1402 /* may be use do_cmdline_cmd? */
1403 do_cmdline((char_u *)cmd, NULL, NULL, DOCMD_NOWAIT|DOCMD_VERBOSE);
1404 update_screen(VALID);
1405
1406 raise_if_error();
1407 return scheme_void;
1408}
1409
1410/* (eval {expr-string}) */
1411 static Scheme_Object *
1412vim_eval(void *data, int argc, Scheme_Object **argv)
1413{
1414#ifdef FEAT_EVAL
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001415 Vim_Prim *prim = (Vim_Prim *)data;
1416 char *expr;
1417 Scheme_Object *result;
1418 /* hash table to store visited values to avoid infinite loops */
1419 Scheme_Hash_Table *visited = NULL;
1420 typval_T *vim_result;
1421
1422 MZ_GC_DECL_REG(1);
1423 MZ_GC_VAR_IN_REG(0, visited);
1424 MZ_GC_REG();
1425
1426 visited = scheme_make_hash_table(SCHEME_hash_ptr);
1427 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001428
1429 expr = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0));
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001430 vim_result = eval_expr((char_u *)expr, NULL);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001431
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001432 if (vim_result == NULL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001433 raise_vim_exn(_("invalid expression"));
1434
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001435 result = vim_to_mzscheme(vim_result, 1, visited);
1436 free_tv(vim_result);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001437
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001438 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001439 return result;
1440#else
1441 raise_vim_exn(_("expressions disabled at compile time"));
1442 /* unreachable */
1443 return scheme_false;
1444#endif
1445}
1446
1447/* (range-start) */
1448 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001449get_range_start(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001450{
1451 return scheme_make_integer(range_start);
1452}
1453
1454/* (range-end) */
1455 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001456get_range_end(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001457{
1458 return scheme_make_integer(range_end);
1459}
1460
1461/* (beep) */
1462 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001463mzscheme_beep(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001464{
1465 vim_beep();
1466 return scheme_void;
1467}
1468
1469static Scheme_Object *M_global = NULL;
1470
1471/* (get-option {option-name}) [buffer/window] */
1472 static Scheme_Object *
1473get_option(void *data, int argc, Scheme_Object **argv)
1474{
1475 Vim_Prim *prim = (Vim_Prim *)data;
1476 char_u *name;
1477 long value;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001478 char *strval;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001479 int rc;
1480 Scheme_Object *rval;
1481 int opt_flags = 0;
1482 buf_T *save_curb = curbuf;
1483 win_T *save_curw = curwin;
1484
1485 name = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0));
1486
1487 if (argc > 1)
1488 {
1489 if (M_global == NULL)
1490 {
1491 MZ_REGISTER_STATIC(M_global);
1492 M_global = scheme_intern_symbol("global");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001493 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001494 }
1495
1496 if (argv[1] == M_global)
1497 opt_flags = OPT_GLOBAL;
1498 else if (SCHEME_VIMBUFFERP(argv[1]))
1499 {
1500 curbuf = get_valid_buffer(argv[1]);
1501 opt_flags = OPT_LOCAL;
1502 }
1503 else if (SCHEME_VIMWINDOWP(argv[1]))
1504 {
1505 win_T *win = get_valid_window(argv[1]);
1506
1507 curwin = win;
1508 curbuf = win->w_buffer;
1509 opt_flags = OPT_LOCAL;
1510 }
1511 else
1512 scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv);
1513 }
1514
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001515 rc = get_option_value(name, &value, (char_u **)&strval, opt_flags);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001516 curbuf = save_curb;
1517 curwin = save_curw;
1518
1519 switch (rc)
1520 {
1521 case 1:
1522 return scheme_make_integer_value(value);
1523 case 0:
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001524 rval = scheme_make_string(strval);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001525 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001526 vim_free(strval);
1527 return rval;
1528 case -1:
1529 case -2:
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001530 raise_vim_exn(_("hidden option"));
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001531 case -3:
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001532 raise_vim_exn(_("unknown option"));
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001533 }
1534 /* unreachable */
1535 return scheme_void;
1536}
1537
1538/* (set-option {option-changing-string} [buffer/window]) */
1539 static Scheme_Object *
1540set_option(void *data, int argc, Scheme_Object **argv)
1541{
1542 char_u *cmd;
1543 int opt_flags = 0;
1544 buf_T *save_curb = curbuf;
1545 win_T *save_curw = curwin;
1546 Vim_Prim *prim = (Vim_Prim *)data;
1547
1548 GUARANTEE_STRING(prim->name, 0);
1549 if (argc > 1)
1550 {
1551 if (M_global == NULL)
1552 {
1553 MZ_REGISTER_STATIC(M_global);
1554 M_global = scheme_intern_symbol("global");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001555 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001556 }
1557
1558 if (argv[1] == M_global)
1559 opt_flags = OPT_GLOBAL;
1560 else if (SCHEME_VIMBUFFERP(argv[1]))
1561 {
1562 curbuf = get_valid_buffer(argv[1]);
1563 opt_flags = OPT_LOCAL;
1564 }
1565 else if (SCHEME_VIMWINDOWP(argv[1]))
1566 {
1567 win_T *win = get_valid_window(argv[1]);
1568 curwin = win;
1569 curbuf = win->w_buffer;
1570 opt_flags = OPT_LOCAL;
1571 }
1572 else
1573 scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv);
1574 }
1575
1576 /* do_set can modify cmd, make copy */
1577 cmd = vim_strsave((char_u *)SCHEME_STR_VAL(argv[0]));
1578 do_set(cmd, opt_flags);
1579 vim_free(cmd);
1580 update_screen(NOT_VALID);
1581 curbuf = save_curb;
1582 curwin = save_curw;
1583 raise_if_error();
1584 return scheme_void;
1585}
1586
1587/*
1588 *===========================================================================
1589 * 5. Vim Window-related Manipulation Functions
1590 *===========================================================================
1591 */
1592
1593/* (curr-win) */
1594 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001595get_curr_win(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001596{
1597 return (Scheme_Object *)get_vim_curr_window();
1598}
1599
1600/* (win-count) */
1601 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001602get_window_count(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001603{
1604 win_T *w;
1605 int n = 0;
1606
Bram Moolenaarf740b292006-02-16 22:11:02 +00001607 for (w = firstwin; w != NULL; w = w->w_next)
1608 ++n;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001609 return scheme_make_integer(n);
1610}
1611
1612/* (get-win-list [buffer]) */
1613 static Scheme_Object *
1614get_window_list(void *data, int argc, Scheme_Object **argv)
1615{
1616 Vim_Prim *prim = (Vim_Prim *)data;
1617 vim_mz_buffer *buf;
1618 Scheme_Object *list;
1619 win_T *w;
1620
1621 buf = get_buffer_arg(prim->name, 0, argc, argv);
1622 list = scheme_null;
1623
Bram Moolenaarf740b292006-02-16 22:11:02 +00001624 for (w = firstwin; w != NULL; w = w->w_next)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001625 if (w->w_buffer == buf->buf)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001626 {
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001627 list = scheme_make_pair(window_new(w), list);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001628 MZ_GC_CHECK();
1629 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001630
1631 return list;
1632}
1633
1634 static Scheme_Object *
1635window_new(win_T *win)
1636{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001637 vim_mz_window *self = NULL;
1638
1639 MZ_GC_DECL_REG(1);
1640 MZ_GC_VAR_IN_REG(0, self);
1641 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001642
1643 /* We need to handle deletion of windows underneath us.
Bram Moolenaare344bea2005-09-01 20:46:49 +00001644 * If we add a "w_mzscheme_ref" field to the win_T structure,
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001645 * then we can get at it in win_free() in vim.
1646 *
1647 * On a win_free() we set the Scheme object's win_T *field
1648 * to an invalid value. We trap all uses of a window
1649 * object, and reject them if the win_T *field is invalid.
1650 */
Bram Moolenaare344bea2005-09-01 20:46:49 +00001651 if (win->w_mzscheme_ref != NULL)
1652 return win->w_mzscheme_ref;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001653
1654 self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_window));
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001655 vim_memset(self, 0, sizeof(vim_mz_window));
1656 scheme_dont_gc_ptr(self); /* because win isn't visible to GC */
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001657 MZ_GC_CHECK();
Bram Moolenaare344bea2005-09-01 20:46:49 +00001658 win->w_mzscheme_ref = self;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001659 self->win = win;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001660 self->so.type = mz_window_type;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001661
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001662 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001663 return (Scheme_Object *)(self);
1664}
1665
1666/* (get-win-num [window]) */
1667 static Scheme_Object *
1668get_window_num(void *data, int argc, Scheme_Object **argv)
1669{
1670 Vim_Prim *prim = (Vim_Prim *)data;
1671 win_T *win = get_window_arg(prim->name, 0, argc, argv)->win;
1672 int nr = 1;
1673 win_T *wp;
1674
1675 for (wp = firstwin; wp != win; wp = wp->w_next)
1676 ++nr;
1677
1678 return scheme_make_integer(nr);
1679}
1680
1681/* (get-win-by-num {windownum}) */
1682 static Scheme_Object *
1683get_window_by_num(void *data, int argc, Scheme_Object **argv)
1684{
1685 Vim_Prim *prim = (Vim_Prim *)data;
1686 win_T *win;
1687 int fnum;
1688
1689 fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1690 if (fnum < 1)
1691 scheme_signal_error(_("window index is out of range"));
1692
Bram Moolenaarf740b292006-02-16 22:11:02 +00001693 for (win = firstwin; win != NULL; win = win->w_next, --fnum)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001694 if (fnum == 1) /* to be 1-based */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001695 return window_new(win);
1696
1697 return scheme_false;
1698}
1699
1700/* (get-win-buffer [window]) */
1701 static Scheme_Object *
1702get_window_buffer(void *data, int argc, Scheme_Object **argv)
1703{
1704 Vim_Prim *prim = (Vim_Prim *)data;
1705 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
1706
1707 return buffer_new(win->win->w_buffer);
1708}
1709
1710/* (get-win-height [window]) */
1711 static Scheme_Object *
1712get_window_height(void *data, int argc, Scheme_Object **argv)
1713{
1714 Vim_Prim *prim = (Vim_Prim *)data;
1715 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
1716
1717 return scheme_make_integer(win->win->w_height);
1718}
1719
1720/* (set-win-height {height} [window]) */
1721 static Scheme_Object *
1722set_window_height(void *data, int argc, Scheme_Object **argv)
1723{
1724 Vim_Prim *prim = (Vim_Prim *)data;
1725 vim_mz_window *win;
1726 win_T *savewin;
1727 int height;
1728
1729 win = get_window_arg(prim->name, 1, argc, argv);
1730 height = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1731
1732#ifdef FEAT_GUI
1733 need_mouse_correct = TRUE;
1734#endif
1735
1736 savewin = curwin;
1737 curwin = win->win;
1738 win_setheight(height);
1739 curwin = savewin;
1740
1741 raise_if_error();
1742 return scheme_void;
1743}
1744
1745#ifdef FEAT_VERTSPLIT
1746/* (get-win-width [window]) */
1747 static Scheme_Object *
1748get_window_width(void *data, int argc, Scheme_Object **argv)
1749{
1750 Vim_Prim *prim = (Vim_Prim *)data;
1751 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
1752
1753 return scheme_make_integer(W_WIDTH(win->win));
1754}
1755
1756/* (set-win-width {width} [window]) */
1757 static Scheme_Object *
1758set_window_width(void *data, int argc, Scheme_Object **argv)
1759{
1760 Vim_Prim *prim = (Vim_Prim *)data;
1761 vim_mz_window *win;
1762 win_T *savewin;
1763 int width = 0;
1764
1765 win = get_window_arg(prim->name, 1, argc, argv);
1766 width = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1767
1768# ifdef FEAT_GUI
1769 need_mouse_correct = TRUE;
1770# endif
1771
1772 savewin = curwin;
1773 curwin = win->win;
1774 win_setwidth(width);
1775 curwin = savewin;
1776
1777 raise_if_error();
1778 return scheme_void;
1779}
1780#endif
1781
1782/* (get-cursor [window]) -> (line . col) */
1783 static Scheme_Object *
1784get_cursor(void *data, int argc, Scheme_Object **argv)
1785{
1786 Vim_Prim *prim = (Vim_Prim *)data;
1787 vim_mz_window *win;
1788 pos_T pos;
1789
1790 win = get_window_arg(prim->name, 0, argc, argv);
1791 pos = win->win->w_cursor;
1792 return scheme_make_pair(scheme_make_integer_value((long)pos.lnum),
1793 scheme_make_integer_value((long)pos.col + 1));
1794}
1795
1796/* (set-cursor (line . col) [window]) */
1797 static Scheme_Object *
1798set_cursor(void *data, int argc, Scheme_Object **argv)
1799{
1800 Vim_Prim *prim = (Vim_Prim *)data;
1801 vim_mz_window *win;
1802 long lnum = 0;
1803 long col = 0;
1804
Bram Moolenaar555b2802005-05-19 21:08:39 +00001805#ifdef HAVE_SANDBOX
1806 sandbox_check();
1807#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001808 win = get_window_arg(prim->name, 1, argc, argv);
1809 GUARANTEE_PAIR(prim->name, 0);
1810
1811 if (!SCHEME_INTP(SCHEME_CAR(argv[0]))
1812 || !SCHEME_INTP(SCHEME_CDR(argv[0])))
1813 scheme_wrong_type(prim->name, "integer pair", 0, argc, argv);
1814
1815 lnum = SCHEME_INT_VAL(SCHEME_CAR(argv[0]));
1816 col = SCHEME_INT_VAL(SCHEME_CDR(argv[0])) - 1;
1817
1818 check_line_range(lnum, win->win->w_buffer);
1819 /* don't know how to catch invalid column value */
1820
1821 win->win->w_cursor.lnum = lnum;
1822 win->win->w_cursor.col = col;
1823 update_screen(VALID);
1824
1825 raise_if_error();
1826 return scheme_void;
1827}
1828/*
1829 *===========================================================================
1830 * 6. Vim Buffer-related Manipulation Functions
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001831 *===========================================================================
1832 */
1833
1834/* (open-buff {filename}) */
1835 static Scheme_Object *
1836mzscheme_open_buffer(void *data, int argc, Scheme_Object **argv)
1837{
1838 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001839 char_u *fname;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001840 int num = 0;
1841 Scheme_Object *onum;
1842
Bram Moolenaar555b2802005-05-19 21:08:39 +00001843#ifdef HAVE_SANDBOX
1844 sandbox_check();
1845#endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001846 fname = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0));
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001847 /* TODO make open existing file */
1848 num = buflist_add(fname, BLN_LISTED | BLN_CURBUF);
1849
1850 if (num == 0)
1851 raise_vim_exn(_("couldn't open buffer"));
1852
1853 onum = scheme_make_integer(num);
1854 return get_buffer_by_num(data, 1, &onum);
1855}
1856
1857/* (get-buff-by-num {buffernum}) */
1858 static Scheme_Object *
1859get_buffer_by_num(void *data, int argc, Scheme_Object **argv)
1860{
1861 Vim_Prim *prim = (Vim_Prim *)data;
1862 buf_T *buf;
1863 int fnum;
1864
1865 fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1866
1867 for (buf = firstbuf; buf; buf = buf->b_next)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001868 if (buf->b_fnum == fnum)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001869 return buffer_new(buf);
1870
1871 return scheme_false;
1872}
1873
1874/* (get-buff-by-name {buffername}) */
1875 static Scheme_Object *
1876get_buffer_by_name(void *data, int argc, Scheme_Object **argv)
1877{
1878 Vim_Prim *prim = (Vim_Prim *)data;
1879 buf_T *buf;
1880 char_u *fname;
1881
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001882 fname = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0));
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001883
1884 for (buf = firstbuf; buf; buf = buf->b_next)
1885 if (buf->b_ffname == NULL || buf->b_sfname == NULL)
1886 /* empty string */
1887 {
1888 if (fname[0] == NUL)
1889 return buffer_new(buf);
1890 }
1891 else if (!fnamecmp(buf->b_ffname, fname)
1892 || !fnamecmp(buf->b_sfname, fname))
1893 /* either short or long filename matches */
1894 return buffer_new(buf);
1895
1896 return scheme_false;
1897}
1898
1899/* (get-next-buff [buffer]) */
1900 static Scheme_Object *
1901get_next_buffer(void *data, int argc, Scheme_Object **argv)
1902{
1903 Vim_Prim *prim = (Vim_Prim *)data;
1904 buf_T *buf = get_buffer_arg(prim->name, 0, argc, argv)->buf;
1905
1906 if (buf->b_next == NULL)
1907 return scheme_false;
1908 else
1909 return buffer_new(buf->b_next);
1910}
1911
1912/* (get-prev-buff [buffer]) */
1913 static Scheme_Object *
1914get_prev_buffer(void *data, int argc, Scheme_Object **argv)
1915{
1916 Vim_Prim *prim = (Vim_Prim *)data;
1917 buf_T *buf = get_buffer_arg(prim->name, 0, argc, argv)->buf;
1918
1919 if (buf->b_prev == NULL)
1920 return scheme_false;
1921 else
1922 return buffer_new(buf->b_prev);
1923}
1924
1925/* (get-buff-num [buffer]) */
1926 static Scheme_Object *
1927get_buffer_num(void *data, int argc, Scheme_Object **argv)
1928{
1929 Vim_Prim *prim = (Vim_Prim *)data;
1930 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
1931
1932 return scheme_make_integer(buf->buf->b_fnum);
1933}
1934
1935/* (buff-count) */
1936 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001937get_buffer_count(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001938{
1939 buf_T *b;
1940 int n = 0;
1941
1942 for (b = firstbuf; b; b = b->b_next) ++n;
1943 return scheme_make_integer(n);
1944}
1945
1946/* (get-buff-name [buffer]) */
1947 static Scheme_Object *
1948get_buffer_name(void *data, int argc, Scheme_Object **argv)
1949{
1950 Vim_Prim *prim = (Vim_Prim *)data;
1951 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
1952
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001953 return scheme_make_string((char *)buf->buf->b_ffname);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001954}
1955
1956/* (curr-buff) */
1957 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001958get_curr_buffer(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001959{
1960 return (Scheme_Object *)get_vim_curr_buffer();
1961}
1962
1963 static Scheme_Object *
1964buffer_new(buf_T *buf)
1965{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001966 vim_mz_buffer *self = NULL;
1967
1968 MZ_GC_DECL_REG(1);
1969 MZ_GC_VAR_IN_REG(0, self);
1970 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001971
1972 /* We need to handle deletion of buffers underneath us.
Bram Moolenaare344bea2005-09-01 20:46:49 +00001973 * If we add a "b_mzscheme_ref" field to the buf_T structure,
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001974 * then we can get at it in buf_freeall() in vim.
1975 */
Bram Moolenaare344bea2005-09-01 20:46:49 +00001976 if (buf->b_mzscheme_ref)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001977 return buf->b_mzscheme_ref;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001978
1979 self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_buffer));
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001980 vim_memset(self, 0, sizeof(vim_mz_buffer));
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001981 scheme_dont_gc_ptr(self); /* because buf isn't visible to GC */
1982 MZ_GC_CHECK();
Bram Moolenaare344bea2005-09-01 20:46:49 +00001983 buf->b_mzscheme_ref = self;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001984 self->buf = buf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001985 self->so.type = mz_buffer_type;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001986
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001987 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001988 return (Scheme_Object *)(self);
1989}
1990
1991/*
1992 * (get-buff-size [buffer])
1993 *
1994 * Get the size (number of lines) in the current buffer.
1995 */
1996 static Scheme_Object *
1997get_buffer_size(void *data, int argc, Scheme_Object **argv)
1998{
1999 Vim_Prim *prim = (Vim_Prim *)data;
2000 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
2001
2002 return scheme_make_integer(buf->buf->b_ml.ml_line_count);
2003}
2004
2005/*
2006 * (get-buff-line {linenr} [buffer])
2007 *
2008 * Get a line from the specified buffer. The line number is
2009 * in Vim format (1-based). The line is returned as a MzScheme
2010 * string object.
2011 */
2012 static Scheme_Object *
2013get_buffer_line(void *data, int argc, Scheme_Object **argv)
2014{
2015 Vim_Prim *prim = (Vim_Prim *)data;
2016 vim_mz_buffer *buf;
2017 int linenr;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002018 char_u *line;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002019
2020 buf = get_buffer_arg(prim->name, 1, argc, argv);
2021 linenr = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2022 line = ml_get_buf(buf->buf, (linenr_T)linenr, FALSE);
2023
2024 raise_if_error();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002025 return scheme_make_string((char *)line);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002026}
2027
2028
2029/*
2030 * (get-buff-line-list {start} {end} [buffer])
2031 *
2032 * Get a list of lines from the specified buffer. The line numbers
2033 * are in Vim format (1-based). The range is from lo up to, but not
2034 * including, hi. The list is returned as a list of string objects.
2035 */
2036 static Scheme_Object *
2037get_buffer_line_list(void *data, int argc, Scheme_Object **argv)
2038{
2039 Vim_Prim *prim = (Vim_Prim *)data;
2040 vim_mz_buffer *buf;
2041 int i, hi, lo, n;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002042 Scheme_Object *list = NULL;
2043
2044 MZ_GC_DECL_REG(1);
2045 MZ_GC_VAR_IN_REG(0, list);
2046 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002047
2048 buf = get_buffer_arg(prim->name, 2, argc, argv);
2049 list = scheme_null;
2050 hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1));
2051 lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2052
2053 /*
2054 * Handle some error conditions
2055 */
2056 if (lo < 0)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002057 lo = 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002058
2059 if (hi < 0)
2060 hi = 0;
2061 if (hi < lo)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002062 hi = lo;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002063
2064 n = hi - lo;
2065
2066 for (i = n; i >= 0; --i)
2067 {
2068 Scheme_Object *str = scheme_make_string(
2069 (char *)ml_get_buf(buf->buf, (linenr_T)(lo+i), FALSE));
2070 raise_if_error();
2071
2072 /* Set the list item */
2073 list = scheme_make_pair(str, list);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002074 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002075 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002076 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002077 return list;
2078}
2079
2080/*
2081 * (set-buff-line {linenr} {string/#f} [buffer])
2082 *
2083 * Replace a line in the specified buffer. The line number is
2084 * in Vim format (1-based). The replacement line is given as
2085 * an MzScheme string object. The object is checked for validity
2086 * and correct format. An exception is thrown if the values are not
2087 * the correct format.
2088 *
2089 * It returns a Scheme Object that indicates the length of the
2090 * string changed.
2091 */
2092 static Scheme_Object *
2093set_buffer_line(void *data, int argc, Scheme_Object **argv)
2094{
Bram Moolenaar0a1c0ec2009-12-16 18:02:47 +00002095 /* First of all, we check the value of the supplied MzScheme object.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002096 * There are three cases:
2097 * 1. #f - this is a deletion.
2098 * 2. A string - this is a replacement.
2099 * 3. Anything else - this is an error.
2100 */
2101 Vim_Prim *prim = (Vim_Prim *)data;
2102 vim_mz_buffer *buf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002103 Scheme_Object *line = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002104 char *save;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002105 int n;
2106
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002107 MZ_GC_DECL_REG(1);
2108 MZ_GC_VAR_IN_REG(0, line);
2109 MZ_GC_REG();
2110
Bram Moolenaar555b2802005-05-19 21:08:39 +00002111#ifdef HAVE_SANDBOX
2112 sandbox_check();
2113#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002114 n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2115 if (!SCHEME_STRINGP(argv[1]) && !SCHEME_FALSEP(argv[1]))
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002116 scheme_wrong_type(prim->name, "string or #f", 1, argc, argv);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002117 line = argv[1];
2118 buf = get_buffer_arg(prim->name, 2, argc, argv);
2119
2120 check_line_range(n, buf->buf);
2121
2122 if (SCHEME_FALSEP(line))
2123 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002124 buf_T *savebuf = curbuf;
2125
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002126 curbuf = buf->buf;
2127
2128 if (u_savedel((linenr_T)n, 1L) == FAIL)
2129 {
2130 curbuf = savebuf;
2131 raise_vim_exn(_("cannot save undo information"));
2132 }
2133 else if (ml_delete((linenr_T)n, FALSE) == FAIL)
2134 {
2135 curbuf = savebuf;
2136 raise_vim_exn(_("cannot delete line"));
2137 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002138 if (buf->buf == curwin->w_buffer)
2139 mz_fix_cursor(n, n + 1, -1);
Bram Moolenaarcdcaa582009-07-09 18:06:49 +00002140 deleted_lines_mark((linenr_T)n, 1L);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002141
2142 curbuf = savebuf;
2143
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002144 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002145 raise_if_error();
2146 return scheme_void;
2147 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002148 else
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002149 {
2150 /* Otherwise it's a line */
2151 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002152
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002153 save = string_to_line(line);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002154
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002155 curbuf = buf->buf;
2156
2157 if (u_savesub((linenr_T)n) == FAIL)
2158 {
2159 curbuf = savebuf;
2160 vim_free(save);
2161 raise_vim_exn(_("cannot save undo information"));
2162 }
2163 else if (ml_replace((linenr_T)n, (char_u *)save, TRUE) == FAIL)
2164 {
2165 curbuf = savebuf;
2166 vim_free(save);
2167 raise_vim_exn(_("cannot replace line"));
2168 }
2169 else
2170 {
2171 vim_free(save);
2172 changed_bytes((linenr_T)n, 0);
2173 }
2174
2175 curbuf = savebuf;
2176
2177 /* Check that the cursor is not beyond the end of the line now. */
2178 if (buf->buf == curwin->w_buffer)
2179 check_cursor_col();
2180
2181 MZ_GC_UNREG();
2182 raise_if_error();
2183 return scheme_void;
2184 }
2185}
2186
2187 static void
2188free_array(char **array)
2189{
2190 char **curr = array;
2191 while (*curr != NULL)
2192 vim_free(*curr++);
2193 vim_free(array);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002194}
2195
2196/*
2197 * (set-buff-line-list {start} {end} {string-list/#f/null} [buffer])
2198 *
2199 * Replace a range of lines in the specified buffer. The line numbers are in
2200 * Vim format (1-based). The range is from lo up to, but not including, hi.
2201 * The replacement lines are given as a Scheme list of string objects. The
2202 * list is checked for validity and correct format.
2203 *
2204 * Errors are returned as a value of FAIL. The return value is OK on success.
2205 * If OK is returned and len_change is not NULL, *len_change is set to the
2206 * change in the buffer length.
2207 */
2208 static Scheme_Object *
2209set_buffer_line_list(void *data, int argc, Scheme_Object **argv)
2210{
2211 /* First of all, we check the type of the supplied MzScheme object.
2212 * There are three cases:
2213 * 1. #f - this is a deletion.
2214 * 2. A list - this is a replacement.
2215 * 3. Anything else - this is an error.
2216 */
2217 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002218 vim_mz_buffer *buf = NULL;
2219 Scheme_Object *line_list = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002220 int i, old_len, new_len, hi, lo;
2221 long extra;
2222
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002223 MZ_GC_DECL_REG(1);
2224 MZ_GC_VAR_IN_REG(0, line_list);
2225 MZ_GC_REG();
2226
Bram Moolenaar555b2802005-05-19 21:08:39 +00002227#ifdef HAVE_SANDBOX
2228 sandbox_check();
2229#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002230 lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2231 hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1));
2232 if (!SCHEME_PAIRP(argv[2])
2233 && !SCHEME_FALSEP(argv[2]) && !SCHEME_NULLP(argv[2]))
2234 scheme_wrong_type(prim->name, "list or #f", 2, argc, argv);
2235 line_list = argv[2];
2236 buf = get_buffer_arg(prim->name, 3, argc, argv);
2237 old_len = hi - lo;
2238 if (old_len < 0) /* process inverse values wisely */
2239 {
2240 i = lo;
2241 lo = hi;
2242 hi = i;
2243 old_len = -old_len;
2244 }
2245 extra = 0;
2246
2247 check_line_range(lo, buf->buf); /* inclusive */
Bram Moolenaarbae0c162007-05-10 19:30:25 +00002248 check_line_range(hi - 1, buf->buf); /* exclusive */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002249
2250 if (SCHEME_FALSEP(line_list) || SCHEME_NULLP(line_list))
2251 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002252 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002253 curbuf = buf->buf;
2254
2255 if (u_savedel((linenr_T)lo, (long)old_len) == FAIL)
2256 {
2257 curbuf = savebuf;
2258 raise_vim_exn(_("cannot save undo information"));
2259 }
2260 else
2261 {
2262 for (i = 0; i < old_len; i++)
2263 if (ml_delete((linenr_T)lo, FALSE) == FAIL)
2264 {
2265 curbuf = savebuf;
2266 raise_vim_exn(_("cannot delete line"));
2267 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002268 if (buf->buf == curwin->w_buffer)
2269 mz_fix_cursor(lo, hi, -old_len);
Bram Moolenaarcdcaa582009-07-09 18:06:49 +00002270 deleted_lines_mark((linenr_T)lo, (long)old_len);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002271 }
2272
2273 curbuf = savebuf;
2274
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002275 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002276 raise_if_error();
2277 return scheme_void;
2278 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002279 else
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002280 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002281 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002282
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002283 /* List */
2284 new_len = scheme_proper_list_length(line_list);
2285 MZ_GC_CHECK();
2286 if (new_len < 0) /* improper or cyclic list */
2287 scheme_wrong_type(prim->name, "proper list",
2288 2, argc, argv);
2289 else
2290 {
2291 char **array = NULL;
2292 Scheme_Object *line = NULL;
2293 Scheme_Object *rest = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002294
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002295 MZ_GC_DECL_REG(2);
2296 MZ_GC_VAR_IN_REG(0, line);
2297 MZ_GC_VAR_IN_REG(1, rest);
2298 MZ_GC_REG();
2299
2300 array = (char **)alloc(new_len * sizeof(char *));
2301 vim_memset(array, 0, new_len * sizeof(char *));
2302
2303 rest = line_list;
2304 for (i = 0; i < new_len; ++i)
2305 {
2306 line = SCHEME_CAR(rest);
2307 rest = SCHEME_CDR(rest);
2308 if (!SCHEME_STRINGP(line))
2309 {
2310 free_array(array);
2311 scheme_wrong_type(prim->name, "string-list", 2, argc, argv);
2312 }
2313 array[i] = string_to_line(line);
2314 }
2315
2316 curbuf = buf->buf;
2317
2318 if (u_save((linenr_T)(lo-1), (linenr_T)hi) == FAIL)
2319 {
2320 curbuf = savebuf;
2321 free_array(array);
2322 raise_vim_exn(_("cannot save undo information"));
2323 }
2324
2325 /*
2326 * If the size of the range is reducing (ie, new_len < old_len) we
2327 * need to delete some old_len. We do this at the start, by
2328 * repeatedly deleting line "lo".
2329 */
2330 for (i = 0; i < old_len - new_len; ++i)
2331 {
2332 if (ml_delete((linenr_T)lo, FALSE) == FAIL)
2333 {
2334 curbuf = savebuf;
2335 free_array(array);
2336 raise_vim_exn(_("cannot delete line"));
2337 }
2338 extra--;
2339 }
2340
2341 /*
2342 * For as long as possible, replace the existing old_len with the
2343 * new old_len. This is a more efficient operation, as it requires
2344 * less memory allocation and freeing.
2345 */
2346 for (i = 0; i < old_len && i < new_len; i++)
2347 if (ml_replace((linenr_T)(lo+i), (char_u *)array[i], TRUE) == FAIL)
2348 {
2349 curbuf = savebuf;
2350 free_array(array);
2351 raise_vim_exn(_("cannot replace line"));
2352 }
2353
2354 /*
2355 * Now we may need to insert the remaining new_len. We don't need to
2356 * free the string passed back because MzScheme has control of that
2357 * memory.
2358 */
2359 while (i < new_len)
2360 {
2361 if (ml_append((linenr_T)(lo + i - 1),
2362 (char_u *)array[i], 0, FALSE) == FAIL)
2363 {
2364 curbuf = savebuf;
2365 free_array(array);
2366 raise_vim_exn(_("cannot insert line"));
2367 }
2368 ++i;
2369 ++extra;
2370 }
2371 MZ_GC_UNREG();
2372 free_array(array);
2373 }
2374
2375 /*
2376 * Adjust marks. Invalidate any which lie in the
2377 * changed range, and move any in the remainder of the buffer.
2378 */
2379 mark_adjust((linenr_T)lo, (linenr_T)(hi - 1), (long)MAXLNUM, (long)extra);
2380 changed_lines((linenr_T)lo, 0, (linenr_T)hi, (long)extra);
2381
2382 if (buf->buf == curwin->w_buffer)
2383 mz_fix_cursor(lo, hi, extra);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002384 curbuf = savebuf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002385
2386 MZ_GC_UNREG();
2387 raise_if_error();
2388 return scheme_void;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002389 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002390}
2391
2392/*
2393 * (insert-buff-line-list {linenr} {string/string-list} [buffer])
2394 *
Bram Moolenaar0a1c0ec2009-12-16 18:02:47 +00002395 * Insert a number of lines into the specified buffer after the specified line.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002396 * The line number is in Vim format (1-based). The lines to be inserted are
2397 * given as an MzScheme list of string objects or as a single string. The lines
2398 * to be added are checked for validity and correct format. Errors are
2399 * returned as a value of FAIL. The return value is OK on success.
2400 * If OK is returned and len_change is not NULL, *len_change
2401 * is set to the change in the buffer length.
2402 */
2403 static Scheme_Object *
2404insert_buffer_line_list(void *data, int argc, Scheme_Object **argv)
2405{
2406 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002407 vim_mz_buffer *buf = NULL;
2408 Scheme_Object *list = NULL;
2409 char *str = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002410 int i, n, size;
2411
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002412 MZ_GC_DECL_REG(1);
2413 MZ_GC_VAR_IN_REG(0, list);
2414 MZ_GC_REG();
2415
Bram Moolenaar555b2802005-05-19 21:08:39 +00002416#ifdef HAVE_SANDBOX
2417 sandbox_check();
2418#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002419 /*
2420 * First of all, we check the type of the supplied MzScheme object.
2421 * It must be a string or a list, or the call is in error.
2422 */
2423 n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2424 list = argv[1];
2425
2426 if (!SCHEME_STRINGP(list) && !SCHEME_PAIRP(list))
2427 scheme_wrong_type(prim->name, "string or list", 1, argc, argv);
2428 buf = get_buffer_arg(prim->name, 2, argc, argv);
2429
2430 if (n != 0) /* 0 can be used in insert */
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002431 check_line_range(n, buf->buf);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002432 if (SCHEME_STRINGP(list))
2433 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002434 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002435
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002436 str = string_to_line(list);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002437 curbuf = buf->buf;
2438
2439 if (u_save((linenr_T)n, (linenr_T)(n+1)) == FAIL)
2440 {
2441 curbuf = savebuf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002442 vim_free(str);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002443 raise_vim_exn(_("cannot save undo information"));
2444 }
2445 else if (ml_append((linenr_T)n, (char_u *)str, 0, FALSE) == FAIL)
2446 {
2447 curbuf = savebuf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002448 vim_free(str);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002449 raise_vim_exn(_("cannot insert line"));
2450 }
2451 else
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002452 {
2453 vim_free(str);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002454 appended_lines_mark((linenr_T)n, 1L);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002455 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002456
2457 curbuf = savebuf;
2458 update_screen(VALID);
2459
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002460 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002461 raise_if_error();
2462 return scheme_void;
2463 }
2464
2465 /* List */
2466 size = scheme_proper_list_length(list);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002467 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002468 if (size < 0) /* improper or cyclic list */
2469 scheme_wrong_type(prim->name, "proper list",
2470 2, argc, argv);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002471 else
2472 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002473 Scheme_Object *line = NULL;
2474 Scheme_Object *rest = NULL;
2475 char **array;
2476 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002477
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002478 MZ_GC_DECL_REG(2);
2479 MZ_GC_VAR_IN_REG(0, line);
2480 MZ_GC_VAR_IN_REG(1, rest);
2481 MZ_GC_REG();
2482
2483 array = (char **)alloc(size * sizeof(char *));
2484 vim_memset(array, 0, size * sizeof(char *));
2485
2486 rest = list;
2487 for (i = 0; i < size; ++i)
2488 {
2489 line = SCHEME_CAR(rest);
2490 rest = SCHEME_CDR(rest);
2491 array[i] = string_to_line(line);
2492 }
2493
2494 curbuf = buf->buf;
2495
2496 if (u_save((linenr_T)n, (linenr_T)(n + 1)) == FAIL)
2497 {
2498 curbuf = savebuf;
2499 free_array(array);
2500 raise_vim_exn(_("cannot save undo information"));
2501 }
2502 else
2503 {
2504 for (i = 0; i < size; ++i)
2505 if (ml_append((linenr_T)(n + i), (char_u *)array[i],
2506 0, FALSE) == FAIL)
2507 {
2508 curbuf = savebuf;
2509 free_array(array);
2510 raise_vim_exn(_("cannot insert line"));
2511 }
2512
2513 if (i > 0)
2514 appended_lines_mark((linenr_T)n, (long)i);
2515 }
2516 free_array(array);
2517 MZ_GC_UNREG();
2518 curbuf = savebuf;
2519 update_screen(VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002520 }
2521
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002522 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002523 raise_if_error();
2524 return scheme_void;
2525}
2526
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002527/*
2528 * Predicates
2529 */
2530/* (buff? obj) */
2531 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002532vim_bufferp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002533{
2534 if (SCHEME_VIMBUFFERP(argv[0]))
2535 return scheme_true;
2536 else
2537 return scheme_false;
2538}
2539
2540/* (win? obj) */
2541 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002542vim_windowp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002543{
2544 if (SCHEME_VIMWINDOWP(argv[0]))
2545 return scheme_true;
2546 else
2547 return scheme_false;
2548}
2549
2550/* (buff-valid? obj) */
2551 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002552vim_buffer_validp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002553{
2554 if (SCHEME_VIMBUFFERP(argv[0])
2555 && ((vim_mz_buffer *)argv[0])->buf != INVALID_BUFFER_VALUE)
2556 return scheme_true;
2557 else
2558 return scheme_false;
2559}
2560
2561/* (win-valid? obj) */
2562 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002563vim_window_validp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002564{
2565 if (SCHEME_VIMWINDOWP(argv[0])
2566 && ((vim_mz_window *)argv[0])->win != INVALID_WINDOW_VALUE)
2567 return scheme_true;
2568 else
2569 return scheme_false;
2570}
2571
2572/*
2573 *===========================================================================
2574 * Utilities
2575 *===========================================================================
2576 */
2577
2578/*
2579 * Convert an MzScheme string into a Vim line.
2580 *
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002581 * All internal nulls are replaced by newline characters.
2582 * It is an error for the string to contain newline characters.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002583 *
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002584 * Returns pointer to Vim allocated memory
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002585 */
2586 static char *
2587string_to_line(Scheme_Object *obj)
2588{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002589 char *scheme_str = NULL;
2590 char *vim_str = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002591 long len;
2592 int i;
2593
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002594 scheme_str = scheme_display_to_string(obj, &len);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002595
2596 /* Error checking: String must not contain newlines, as we
2597 * are replacing a single line, and we must replace it with
2598 * a single line.
2599 */
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002600 if (memchr(scheme_str, '\n', len))
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002601 scheme_signal_error(_("string cannot contain newlines"));
2602
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002603 vim_str = (char *)alloc(len + 1);
2604
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002605 /* Create a copy of the string, with internal nulls replaced by
2606 * newline characters, as is the vim convention.
2607 */
2608 for (i = 0; i < len; ++i)
2609 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002610 if (scheme_str[i] == '\0')
2611 vim_str[i] = '\n';
2612 else
2613 vim_str[i] = scheme_str[i];
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002614 }
2615
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002616 vim_str[i] = '\0';
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002617
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002618 MZ_GC_CHECK();
2619 return vim_str;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002620}
2621
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002622#ifdef FEAT_EVAL
2623/*
2624 * Convert Vim value into MzScheme, adopted from if_python.c
2625 */
2626 static Scheme_Object *
2627vim_to_mzscheme(typval_T *vim_value, int depth, Scheme_Hash_Table *visited)
2628{
2629 Scheme_Object *result = NULL;
2630 int new_value = TRUE;
2631
2632 MZ_GC_DECL_REG(1);
2633 MZ_GC_VAR_IN_REG(0, result);
2634 MZ_GC_REG();
2635
2636 /* Avoid infinite recursion */
2637 if (depth > 100)
2638 {
2639 MZ_GC_UNREG();
2640 return scheme_void;
2641 }
2642
2643 /* Check if we run into a recursive loop. The item must be in visited
2644 * then and we can use it again.
2645 */
2646 result = scheme_hash_get(visited, (Scheme_Object *)vim_value);
2647 MZ_GC_CHECK();
2648 if (result != NULL) /* found, do nothing */
2649 new_value = FALSE;
2650 else if (vim_value->v_type == VAR_STRING)
2651 {
Bram Moolenaard04da7c2012-10-14 03:41:59 +02002652 result = scheme_make_string(vim_value->vval.v_string == NULL
2653 ? "" : (char *)vim_value->vval.v_string);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002654 MZ_GC_CHECK();
2655 }
2656 else if (vim_value->v_type == VAR_NUMBER)
2657 {
2658 result = scheme_make_integer((long)vim_value->vval.v_number);
2659 MZ_GC_CHECK();
2660 }
2661# ifdef FEAT_FLOAT
2662 else if (vim_value->v_type == VAR_FLOAT)
2663 {
2664 result = scheme_make_double((double)vim_value->vval.v_float);
2665 MZ_GC_CHECK();
2666 }
2667# endif
2668 else if (vim_value->v_type == VAR_LIST)
2669 {
2670 list_T *list = vim_value->vval.v_list;
2671 listitem_T *curr;
2672
2673 if (list == NULL || list->lv_first == NULL)
2674 result = scheme_null;
2675 else
2676 {
2677 Scheme_Object *obj = NULL;
2678
2679 MZ_GC_DECL_REG(1);
2680 MZ_GC_VAR_IN_REG(0, obj);
2681 MZ_GC_REG();
2682
2683 curr = list->lv_last;
2684 obj = vim_to_mzscheme(&curr->li_tv, depth + 1, visited);
2685 result = scheme_make_pair(obj, scheme_null);
2686 MZ_GC_CHECK();
2687
2688 while (curr != list->lv_first)
2689 {
2690 curr = curr->li_prev;
2691 obj = vim_to_mzscheme(&curr->li_tv, depth + 1, visited);
2692 result = scheme_make_pair(obj, result);
2693 MZ_GC_CHECK();
2694 }
2695 }
2696 MZ_GC_UNREG();
2697 }
2698 else if (vim_value->v_type == VAR_DICT)
2699 {
2700 Scheme_Object *key = NULL;
2701 Scheme_Object *obj = NULL;
2702
2703 MZ_GC_DECL_REG(2);
2704 MZ_GC_VAR_IN_REG(0, key);
2705 MZ_GC_VAR_IN_REG(1, obj);
2706 MZ_GC_REG();
2707
2708 result = (Scheme_Object *)scheme_make_hash_table(SCHEME_hash_ptr);
2709 MZ_GC_CHECK();
2710 if (vim_value->vval.v_dict != NULL)
2711 {
2712 hashtab_T *ht = &vim_value->vval.v_dict->dv_hashtab;
2713 long_u todo = ht->ht_used;
2714 hashitem_T *hi;
2715 dictitem_T *di;
2716
2717 for (hi = ht->ht_array; todo > 0; ++hi)
2718 {
2719 if (!HASHITEM_EMPTY(hi))
2720 {
2721 --todo;
2722
2723 di = dict_lookup(hi);
2724 obj = vim_to_mzscheme(&di->di_tv, depth + 1, visited);
2725 key = scheme_make_string((char *)hi->hi_key);
2726 MZ_GC_CHECK();
2727 scheme_hash_set((Scheme_Hash_Table *)result, key, obj);
2728 MZ_GC_CHECK();
2729 }
2730 }
2731 }
2732 MZ_GC_UNREG();
2733 }
2734 else
2735 {
2736 result = scheme_void;
2737 new_value = FALSE;
2738 }
2739 if (new_value)
2740 {
2741 scheme_hash_set(visited, (Scheme_Object *)vim_value, result);
2742 MZ_GC_CHECK();
2743 }
2744 MZ_GC_UNREG();
2745 return result;
2746}
Bram Moolenaar7e506b62010-01-19 15:55:06 +01002747
2748 static int
2749mzscheme_to_vim(Scheme_Object *obj, typval_T *tv, int depth,
2750 Scheme_Hash_Table *visited)
2751{
2752 int status = OK;
2753 typval_T *found;
2754 MZ_GC_CHECK();
2755 if (depth > 100) /* limit the deepest recursion level */
2756 {
2757 tv->v_type = VAR_NUMBER;
2758 tv->vval.v_number = 0;
2759 return FAIL;
2760 }
2761
2762 found = (typval_T *)scheme_hash_get(visited, obj);
2763 if (found != NULL)
2764 copy_tv(found, tv);
2765 else if (SCHEME_VOIDP(obj))
2766 {
2767 tv->v_type = VAR_NUMBER;
2768 tv->vval.v_number = 0;
2769 }
2770 else if (SCHEME_INTP(obj))
2771 {
2772 tv->v_type = VAR_NUMBER;
2773 tv->vval.v_number = SCHEME_INT_VAL(obj);
2774 }
2775 else if (SCHEME_BOOLP(obj))
2776 {
2777 tv->v_type = VAR_NUMBER;
2778 tv->vval.v_number = SCHEME_TRUEP(obj);
2779 }
2780# ifdef FEAT_FLOAT
2781 else if (SCHEME_DBLP(obj))
2782 {
2783 tv->v_type = VAR_FLOAT;
2784 tv->vval.v_float = SCHEME_DBL_VAL(obj);
2785 }
2786# endif
2787 else if (SCHEME_STRINGP(obj))
2788 {
2789 tv->v_type = VAR_STRING;
2790 tv->vval.v_string = vim_strsave((char_u *)SCHEME_STR_VAL(obj));
2791 }
2792 else if (SCHEME_VECTORP(obj) || SCHEME_NULLP(obj)
2793 || SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj))
2794 {
2795 list_T *list = list_alloc();
2796 if (list == NULL)
2797 status = FAIL;
2798 else
2799 {
2800 int i;
2801 Scheme_Object *curr = NULL;
2802 Scheme_Object *cval = NULL;
2803 /* temporary var to hold current element of vectors and pairs */
2804 typval_T *v;
2805
2806 MZ_GC_DECL_REG(2);
2807 MZ_GC_VAR_IN_REG(0, curr);
2808 MZ_GC_VAR_IN_REG(1, cval);
2809 MZ_GC_REG();
2810
2811 tv->v_type = VAR_LIST;
2812 tv->vval.v_list = list;
2813 ++list->lv_refcount;
2814
2815 v = (typval_T *)alloc(sizeof(typval_T));
2816 if (v == NULL)
2817 status = FAIL;
2818 else
2819 {
2820 /* add the value in advance to allow handling of self-referencial
2821 * data structures */
2822 typval_T *visited_tv = (typval_T *)alloc(sizeof(typval_T));
2823 copy_tv(tv, visited_tv);
2824 scheme_hash_set(visited, obj, (Scheme_Object *)visited_tv);
2825
2826 if (SCHEME_VECTORP(obj))
2827 {
2828 for (i = 0; i < SCHEME_VEC_SIZE(obj); ++i)
2829 {
2830 cval = SCHEME_VEC_ELS(obj)[i];
2831 status = mzscheme_to_vim(cval, v, depth + 1, visited);
2832 if (status == FAIL)
2833 break;
2834 status = list_append_tv(list, v);
2835 clear_tv(v);
2836 if (status == FAIL)
2837 break;
2838 }
2839 }
2840 else if (SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj))
2841 {
2842 for (curr = obj;
2843 SCHEME_PAIRP(curr) || SCHEME_MUTABLE_PAIRP(curr);
2844 curr = SCHEME_CDR(curr))
2845 {
2846 cval = SCHEME_CAR(curr);
2847 status = mzscheme_to_vim(cval, v, depth + 1, visited);
2848 if (status == FAIL)
2849 break;
2850 status = list_append_tv(list, v);
2851 clear_tv(v);
2852 if (status == FAIL)
2853 break;
2854 }
2855 /* impoper list not terminated with null
2856 * need to handle the last element */
2857 if (status == OK && !SCHEME_NULLP(curr))
2858 {
2859 status = mzscheme_to_vim(cval, v, depth + 1, visited);
2860 if (status == OK)
2861 {
2862 status = list_append_tv(list, v);
2863 clear_tv(v);
2864 }
2865 }
2866 }
2867 /* nothing to do for scheme_null */
2868 vim_free(v);
2869 }
2870 MZ_GC_UNREG();
2871 }
2872 }
2873 else if (SCHEME_HASHTP(obj))
2874 {
2875 int i;
2876 dict_T *dict;
2877 Scheme_Object *key = NULL;
2878 Scheme_Object *val = NULL;
2879
2880 MZ_GC_DECL_REG(2);
2881 MZ_GC_VAR_IN_REG(0, key);
2882 MZ_GC_VAR_IN_REG(1, val);
2883 MZ_GC_REG();
2884
2885 dict = dict_alloc();
2886 if (dict == NULL)
2887 status = FAIL;
2888 else
2889 {
2890 typval_T *visited_tv = (typval_T *)alloc(sizeof(typval_T));
2891
2892 tv->v_type = VAR_DICT;
2893 tv->vval.v_dict = dict;
2894 ++dict->dv_refcount;
2895
2896 copy_tv(tv, visited_tv);
2897 scheme_hash_set(visited, obj, (Scheme_Object *)visited_tv);
2898
2899 for (i = 0; i < ((Scheme_Hash_Table *)obj)->size; ++i)
2900 {
2901 if (((Scheme_Hash_Table *) obj)->vals[i] != NULL)
2902 {
2903 /* generate item for `diplay'ed Scheme key */
2904 dictitem_T *item = dictitem_alloc((char_u *)string_to_line(
2905 ((Scheme_Hash_Table *) obj)->keys[i]));
2906 /* convert Scheme val to Vim and add it to the dict */
2907 if (mzscheme_to_vim(((Scheme_Hash_Table *) obj)->vals[i],
2908 &item->di_tv, depth + 1, visited) == FAIL
2909 || dict_add(dict, item) == FAIL)
2910 {
2911 dictitem_free(item);
2912 status = FAIL;
2913 break;
2914 }
2915 }
2916
2917 }
2918 }
2919 MZ_GC_UNREG();
2920 }
2921 else
2922 {
2923 /* `display' any other value to string */
2924 tv->v_type = VAR_STRING;
2925 tv->vval.v_string = (char_u *)string_to_line(obj);
2926 }
2927 return status;
2928}
2929
2930 void
2931do_mzeval(char_u *str, typval_T *rettv)
2932{
2933 int i;
2934 Scheme_Object *ret = NULL;
2935 Scheme_Hash_Table *visited = NULL;
2936
2937 MZ_GC_DECL_REG(2);
2938 MZ_GC_VAR_IN_REG(0, ret);
2939 MZ_GC_VAR_IN_REG(0, visited);
2940 MZ_GC_REG();
2941
2942 if (mzscheme_init())
2943 {
2944 MZ_GC_UNREG();
2945 return;
2946 }
2947
2948 MZ_GC_CHECK();
2949 visited = scheme_make_hash_table(SCHEME_hash_ptr);
2950 MZ_GC_CHECK();
2951
2952 if (eval_with_exn_handling(str, do_eval, &ret) == OK)
2953 mzscheme_to_vim(ret, rettv, 1, visited);
2954
2955 for (i = 0; i < visited->size; ++i)
2956 {
2957 /* free up remembered objects */
2958 if (visited->vals[i] != NULL)
2959 {
2960 free_tv((typval_T *)visited->vals[i]);
2961 }
2962 }
2963
2964 MZ_GC_UNREG();
2965}
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002966#endif
2967
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002968/*
2969 * Check to see whether a Vim error has been reported, or a keyboard
2970 * interrupt (from vim --> got_int) has been detected.
2971 */
2972 static int
2973vim_error_check(void)
2974{
2975 return (got_int || did_emsg);
2976}
2977
2978/*
2979 * register Scheme exn:vim
2980 */
2981 static void
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002982register_vim_exn(void)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002983{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002984 int nc = 0;
2985 int i;
2986 Scheme_Object *struct_exn = NULL;
2987 Scheme_Object *exn_name = NULL;
2988
2989 MZ_GC_DECL_REG(2);
2990 MZ_GC_VAR_IN_REG(0, struct_exn);
2991 MZ_GC_VAR_IN_REG(1, exn_name);
2992 MZ_GC_REG();
2993
2994 exn_name = scheme_intern_symbol("exn:vim");
2995 MZ_GC_CHECK();
2996 struct_exn = scheme_builtin_value("struct:exn");
2997 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002998
2999 if (vim_exn == NULL)
3000 vim_exn = scheme_make_struct_type(exn_name,
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003001 struct_exn, NULL, 0, 0, NULL, NULL
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003002#if MZSCHEME_VERSION_MAJOR >= 299
3003 , NULL
3004#endif
3005 );
3006
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003007
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003008 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003009 Scheme_Object **tmp = NULL;
3010 Scheme_Object *exn_names[5] = {NULL, NULL, NULL, NULL, NULL};
3011 Scheme_Object *exn_values[5] = {NULL, NULL, NULL, NULL, NULL};
3012 MZ_GC_DECL_REG(6);
3013 MZ_GC_ARRAY_VAR_IN_REG(0, exn_names, 5);
3014 MZ_GC_ARRAY_VAR_IN_REG(3, exn_values, 5);
3015 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003016
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003017 tmp = scheme_make_struct_names(exn_name, scheme_null, 0, &nc);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003018 mch_memmove(exn_names, tmp, nc * sizeof(Scheme_Object *));
3019 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003020
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003021 tmp = scheme_make_struct_values(vim_exn, exn_names, nc, 0);
3022 mch_memmove(exn_values, tmp, nc * sizeof(Scheme_Object *));
3023 MZ_GC_CHECK();
3024
3025 for (i = 0; i < nc; i++)
3026 {
3027 scheme_add_global_symbol(exn_names[i],
3028 exn_values[i], environment);
3029 MZ_GC_CHECK();
3030 }
3031 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003032 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003033 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003034}
3035
3036/*
3037 * raise exn:vim, may be with additional info string
3038 */
3039 void
3040raise_vim_exn(const char *add_info)
3041{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003042 char *fmt = _("Vim error: ~a");
3043 Scheme_Object *argv[2] = {NULL, NULL};
3044 Scheme_Object *exn = NULL;
3045
3046 MZ_GC_DECL_REG(4);
3047 MZ_GC_ARRAY_VAR_IN_REG(0, argv, 2);
3048 MZ_GC_VAR_IN_REG(3, exn);
3049 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003050
3051 if (add_info != NULL)
3052 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003053 char *c_string = NULL;
3054 Scheme_Object *byte_string = NULL;
3055 Scheme_Object *info = NULL;
3056
3057 MZ_GC_DECL_REG(3);
3058 MZ_GC_VAR_IN_REG(0, c_string);
3059 MZ_GC_VAR_IN_REG(1, byte_string);
3060 MZ_GC_VAR_IN_REG(2, info);
3061 MZ_GC_REG();
3062
3063 info = scheme_make_string(add_info);
3064 MZ_GC_CHECK();
3065 c_string = scheme_format(fmt, STRLEN(fmt), 1, &info, NULL);
3066 MZ_GC_CHECK();
3067 byte_string = scheme_make_string(c_string);
3068 MZ_GC_CHECK();
3069 argv[0] = scheme_byte_string_to_char_string(byte_string);
3070 MZ_GC_CHECK();
Bram Moolenaar555b2802005-05-19 21:08:39 +00003071 SCHEME_SET_IMMUTABLE(argv[0]);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003072 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003073 }
3074 else
3075 argv[0] = scheme_make_string(_("Vim error"));
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003076 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003077
Bram Moolenaar049377e2007-05-12 15:32:12 +00003078#if MZSCHEME_VERSION_MAJOR < 360
3079 argv[1] = scheme_current_continuation_marks();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003080 MZ_GC_CHECK();
Bram Moolenaar049377e2007-05-12 15:32:12 +00003081#else
Bram Moolenaarc81e5e72007-05-05 18:24:42 +00003082 argv[1] = scheme_current_continuation_marks(NULL);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003083 MZ_GC_CHECK();
Bram Moolenaar049377e2007-05-12 15:32:12 +00003084#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003085
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003086 exn = scheme_make_struct_instance(vim_exn, 2, argv);
3087 MZ_GC_CHECK();
3088 scheme_raise(exn);
3089 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003090}
3091
3092 void
3093raise_if_error(void)
3094{
3095 if (vim_error_check())
3096 raise_vim_exn(NULL);
3097}
3098
3099/* get buffer:
3100 * either current
3101 * or passed as argv[argnum] with checks
3102 */
3103 static vim_mz_buffer *
3104get_buffer_arg(const char *fname, int argnum, int argc, Scheme_Object **argv)
3105{
3106 vim_mz_buffer *b;
3107
3108 if (argc < argnum + 1)
3109 return get_vim_curr_buffer();
3110 if (!SCHEME_VIMBUFFERP(argv[argnum]))
3111 scheme_wrong_type(fname, "vim-buffer", argnum, argc, argv);
3112 b = (vim_mz_buffer *)argv[argnum];
3113 (void)get_valid_buffer(argv[argnum]);
3114 return b;
3115}
3116
3117/* get window:
3118 * either current
3119 * or passed as argv[argnum] with checks
3120 */
3121 static vim_mz_window *
3122get_window_arg(const char *fname, int argnum, int argc, Scheme_Object **argv)
3123{
3124 vim_mz_window *w;
3125
3126 if (argc < argnum + 1)
3127 return get_vim_curr_window();
3128 w = (vim_mz_window *)argv[argnum];
3129 if (!SCHEME_VIMWINDOWP(argv[argnum]))
3130 scheme_wrong_type(fname, "vim-window", argnum, argc, argv);
3131 (void)get_valid_window(argv[argnum]);
3132 return w;
3133}
3134
3135/* get valid Vim buffer from Scheme_Object* */
3136buf_T *get_valid_buffer(void *obj)
3137{
3138 buf_T *buf = ((vim_mz_buffer *)obj)->buf;
3139
3140 if (buf == INVALID_BUFFER_VALUE)
3141 scheme_signal_error(_("buffer is invalid"));
3142 return buf;
3143}
3144
3145/* get valid Vim window from Scheme_Object* */
3146win_T *get_valid_window(void *obj)
3147{
3148 win_T *win = ((vim_mz_window *)obj)->win;
3149 if (win == INVALID_WINDOW_VALUE)
3150 scheme_signal_error(_("window is invalid"));
3151 return win;
3152}
3153
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003154 int
3155mzthreads_allowed(void)
3156{
3157 return mz_threads_allow;
3158}
3159
3160 static int
3161line_in_range(linenr_T lnum, buf_T *buf)
3162{
3163 return (lnum > 0 && lnum <= buf->b_ml.ml_line_count);
3164}
3165
3166 static void
3167check_line_range(linenr_T lnum, buf_T *buf)
3168{
3169 if (!line_in_range(lnum, buf))
3170 scheme_signal_error(_("linenr out of range"));
3171}
3172
3173/*
3174 * Check if deleting lines made the cursor position invalid
3175 * (or you'll get msg from Vim about invalid linenr).
3176 * Changed the lines from "lo" to "hi" and added "extra" lines (negative if
3177 * deleted). Got from if_python.c
3178 */
3179 static void
3180mz_fix_cursor(int lo, int hi, int extra)
3181{
3182 if (curwin->w_cursor.lnum >= lo)
3183 {
3184 /* Adjust the cursor position if it's in/after the changed
3185 * lines. */
3186 if (curwin->w_cursor.lnum >= hi)
3187 {
3188 curwin->w_cursor.lnum += extra;
3189 check_cursor_col();
3190 }
3191 else if (extra < 0)
3192 {
3193 curwin->w_cursor.lnum = lo;
3194 check_cursor();
3195 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003196 else
3197 check_cursor_col();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003198 changed_cline_bef_curs();
3199 }
3200 invalidate_botline();
3201}
3202
3203static Vim_Prim prims[]=
3204{
3205 /*
3206 * Buffer-related commands
3207 */
3208 {get_buffer_line, "get-buff-line", 1, 2},
3209 {set_buffer_line, "set-buff-line", 2, 3},
3210 {get_buffer_line_list, "get-buff-line-list", 2, 3},
3211 {get_buffer_name, "get-buff-name", 0, 1},
3212 {get_buffer_num, "get-buff-num", 0, 1},
3213 {get_buffer_size, "get-buff-size", 0, 1},
3214 {set_buffer_line_list, "set-buff-line-list", 3, 4},
3215 {insert_buffer_line_list, "insert-buff-line-list", 2, 3},
3216 {get_curr_buffer, "curr-buff", 0, 0},
3217 {get_buffer_count, "buff-count", 0, 0},
3218 {get_next_buffer, "get-next-buff", 0, 1},
3219 {get_prev_buffer, "get-prev-buff", 0, 1},
3220 {mzscheme_open_buffer, "open-buff", 1, 1},
3221 {get_buffer_by_name, "get-buff-by-name", 1, 1},
3222 {get_buffer_by_num, "get-buff-by-num", 1, 1},
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003223 /*
3224 * Window-related commands
3225 */
3226 {get_curr_win, "curr-win", 0, 0},
3227 {get_window_count, "win-count", 0, 0},
3228 {get_window_by_num, "get-win-by-num", 1, 1},
3229 {get_window_num, "get-win-num", 0, 1},
3230 {get_window_buffer, "get-win-buffer", 0, 1},
3231 {get_window_height, "get-win-height", 0, 1},
3232 {set_window_height, "set-win-height", 1, 2},
3233#ifdef FEAT_VERTSPLIT
3234 {get_window_width, "get-win-width", 0, 1},
3235 {set_window_width, "set-win-width", 1, 2},
3236#endif
3237 {get_cursor, "get-cursor", 0, 1},
3238 {set_cursor, "set-cursor", 1, 2},
3239 {get_window_list, "get-win-list", 0, 1},
3240 /*
3241 * Vim-related commands
3242 */
3243 {vim_command, "command", 1, 1},
3244 {vim_eval, "eval", 1, 1},
3245 {get_range_start, "range-start", 0, 0},
3246 {get_range_end, "range-end", 0, 0},
3247 {mzscheme_beep, "beep", 0, 0},
3248 {get_option, "get-option", 1, 2},
3249 {set_option, "set-option", 1, 2},
3250 /*
3251 * small utilities
3252 */
3253 {vim_bufferp, "buff?", 1, 1},
3254 {vim_windowp, "win?", 1, 1},
3255 {vim_buffer_validp, "buff-valid?", 1, 1},
3256 {vim_window_validp, "win-valid?", 1, 1}
3257};
3258
3259/* return MzScheme wrapper for curbuf */
3260 static vim_mz_buffer *
3261get_vim_curr_buffer(void)
3262{
Bram Moolenaare344bea2005-09-01 20:46:49 +00003263 if (curbuf->b_mzscheme_ref == NULL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003264 return (vim_mz_buffer *)buffer_new(curbuf);
3265 else
Bram Moolenaare344bea2005-09-01 20:46:49 +00003266 return (vim_mz_buffer *)curbuf->b_mzscheme_ref;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003267}
3268
3269/* return MzScheme wrapper for curwin */
3270 static vim_mz_window *
3271get_vim_curr_window(void)
3272{
Bram Moolenaare344bea2005-09-01 20:46:49 +00003273 if (curwin->w_mzscheme_ref == NULL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003274 return (vim_mz_window *)window_new(curwin);
3275 else
Bram Moolenaare344bea2005-09-01 20:46:49 +00003276 return (vim_mz_window *)curwin->w_mzscheme_ref;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003277}
3278
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003279 static void
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003280make_modules()
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003281{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003282 int i;
3283 Scheme_Env *mod = NULL;
3284 Scheme_Object *vimext_symbol = NULL;
3285 Scheme_Object *closed_prim = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003286
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003287 MZ_GC_DECL_REG(3);
3288 MZ_GC_VAR_IN_REG(0, mod);
3289 MZ_GC_VAR_IN_REG(1, vimext_symbol);
3290 MZ_GC_VAR_IN_REG(2, closed_prim);
3291 MZ_GC_REG();
3292
3293 vimext_symbol = scheme_intern_symbol("vimext");
3294 MZ_GC_CHECK();
3295 mod = scheme_primitive_module(vimext_symbol, environment);
3296 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003297 /* all prims made closed so they can access their own names */
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003298 for (i = 0; i < (int)(sizeof(prims)/sizeof(prims[0])); i++)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003299 {
3300 Vim_Prim *prim = prims + i;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003301 closed_prim = scheme_make_closed_prim_w_arity(prim->prim, prim, prim->name,
3302 prim->mina, prim->maxa);
3303 scheme_add_global(prim->name, closed_prim, mod);
3304 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003305 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003306 scheme_finish_primitive_module(mod);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003307 MZ_GC_CHECK();
3308 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003309}
Bram Moolenaard857f0e2005-06-21 22:37:39 +00003310
Bram Moolenaar555b2802005-05-19 21:08:39 +00003311#ifdef HAVE_SANDBOX
3312static Scheme_Object *M_write = NULL;
3313static Scheme_Object *M_read = NULL;
3314static Scheme_Object *M_execute = NULL;
3315static Scheme_Object *M_delete = NULL;
3316
3317 static void
Bram Moolenaarc81e5e72007-05-05 18:24:42 +00003318sandbox_check(void)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003319{
3320 if (sandbox)
3321 raise_vim_exn(_("not allowed in the Vim sandbox"));
3322}
3323
Bram Moolenaard857f0e2005-06-21 22:37:39 +00003324/* security guards to force Vim's sandbox restrictions on MzScheme level */
Bram Moolenaar555b2802005-05-19 21:08:39 +00003325 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02003326sandbox_file_guard(int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003327{
3328 if (sandbox)
3329 {
3330 Scheme_Object *requested_access = argv[2];
3331
3332 if (M_write == NULL)
3333 {
3334 MZ_REGISTER_STATIC(M_write);
3335 M_write = scheme_intern_symbol("write");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003336 MZ_GC_CHECK();
Bram Moolenaar555b2802005-05-19 21:08:39 +00003337 }
3338 if (M_read == NULL)
3339 {
3340 MZ_REGISTER_STATIC(M_read);
3341 M_read = scheme_intern_symbol("read");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003342 MZ_GC_CHECK();
Bram Moolenaar555b2802005-05-19 21:08:39 +00003343 }
3344 if (M_execute == NULL)
3345 {
3346 MZ_REGISTER_STATIC(M_execute);
3347 M_execute = scheme_intern_symbol("execute");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003348 MZ_GC_CHECK();
Bram Moolenaar555b2802005-05-19 21:08:39 +00003349 }
3350 if (M_delete == NULL)
3351 {
3352 MZ_REGISTER_STATIC(M_delete);
3353 M_delete = scheme_intern_symbol("delete");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003354 MZ_GC_CHECK();
Bram Moolenaar555b2802005-05-19 21:08:39 +00003355 }
3356
3357 while (!SCHEME_NULLP(requested_access))
3358 {
3359 Scheme_Object *item = SCHEME_CAR(requested_access);
3360 if (scheme_eq(item, M_write) || scheme_eq(item, M_read)
3361 || scheme_eq(item, M_execute) || scheme_eq(item, M_delete))
3362 {
3363 raise_vim_exn(_("not allowed in the Vim sandbox"));
3364 }
3365 requested_access = SCHEME_CDR(requested_access);
3366 }
3367 }
3368 return scheme_void;
3369}
3370
3371 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02003372sandbox_network_guard(int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003373{
3374 return scheme_void;
3375}
3376#endif
Bram Moolenaar76b92b22006-03-24 22:46:53 +00003377
3378#endif