blob: e44714acf84320109d42ddd100cd7aa7dfc42eba [file] [log] [blame]
Bram Moolenaaredf3f972016-08-29 22:49:24 +02001/* vi:set ts=8 sts=4 sw=4 noet:
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002 *
Bram Moolenaar2e6aff32005-01-31 19:25:36 +00003 * MzScheme interface by Sergey Khorev <sergey.khorev@gmail.com>
Bram Moolenaar75676462013-01-30 14:55:42 +01004 * Based on work by Brent Fulgham <bfulgham@debian.org>
Bram Moolenaar325b7a22004-07-05 15:58:32 +00005 * (Based on lots of help from Matthew Flatt)
6 *
7 * This consists of six parts:
8 * 1. MzScheme interpreter main program
9 * 2. Routines that handle the external interface between MzScheme and
10 * Vim.
11 * 3. MzScheme input/output handlers: writes output via [e]msg().
12 * 4. Implementation of the Vim Features for MzScheme
13 * 5. Vim Window-related Manipulation Functions.
14 * 6. Vim Buffer-related Manipulation Functions
15 *
16 * NOTES
17 * 1. Memory, allocated with scheme_malloc*, need not to be freed explicitly,
18 * garbage collector will do it self
19 * 2. Requires at least NORMAL features. I can't imagine why one may want
Martin Tournoij7904fa42022-10-04 16:28:45 +010020 * to build with TINY features but with MzScheme interface.
Bram Moolenaar9e70cf12009-05-26 20:59:55 +000021 * 3. I don't use K&R-style functions. Anyways, MzScheme headers are ANSI.
Bram Moolenaar325b7a22004-07-05 15:58:32 +000022 */
23
Bram Moolenaar325b7a22004-07-05 15:58:32 +000024#include "vim.h"
Bram Moolenaar049377e2007-05-12 15:32:12 +000025
Bram Moolenaar325b7a22004-07-05 15:58:32 +000026#include "if_mzsch.h"
27
Bram Moolenaar2ab2e862019-12-04 21:24:53 +010028// Only do the following when the feature is enabled. Needed for "make
29// depend".
Bram Moolenaar76b92b22006-03-24 22:46:53 +000030#if defined(FEAT_MZSCHEME) || defined(PROTO)
31
Bram Moolenaar4349c572016-01-30 13:28:28 +010032#ifdef PROTO
33typedef int Scheme_Object;
34typedef int Scheme_Closed_Prim;
35typedef int Scheme_Env;
36typedef int Scheme_Hash_Table;
37typedef int Scheme_Type;
38typedef int Scheme_Thread;
39typedef int Scheme_Closed_Prim;
40typedef int mzshort;
41typedef int Scheme_Prim;
42typedef int HINSTANCE;
43#endif
44
Bram Moolenaar4e640bd2016-01-16 16:20:38 +010045/*
46 * scheme_register_tls_space is only available on 32-bit Windows until
47 * racket-6.3. See
48 * http://docs.racket-lang.org/inside/im_memoryalloc.html?q=scheme_register_tls_space
49 */
Bram Moolenaar4f974752019-02-17 17:44:42 +010050#if MZSCHEME_VERSION_MAJOR >= 500 && defined(MSWIN) \
Bram Moolenaar4e640bd2016-01-16 16:20:38 +010051 && defined(USE_THREAD_LOCAL) \
52 && (!defined(_WIN64) || MZSCHEME_VERSION_MAJOR >= 603)
53# define HAVE_TLS_SPACE 1
54#endif
55
56/*
57 * Since version 4.x precise GC requires trampolined startup.
58 * Futures and places in version 5.x need it too.
59 */
60#if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 \
61 || MZSCHEME_VERSION_MAJOR >= 500 \
62 && (defined(MZ_USE_FUTURES) || defined(MZ_USE_PLACES))
63# define TRAMPOLINED_MZVIM_STARTUP
64#endif
65
Bram Moolenaar2ab2e862019-12-04 21:24:53 +010066// Base data structures
Bram Moolenaar325b7a22004-07-05 15:58:32 +000067#define SCHEME_VIMBUFFERP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type)
68#define SCHEME_VIMWINDOWP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_window_type)
69
70typedef struct
71{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +000072 Scheme_Object so;
Bram Moolenaar325b7a22004-07-05 15:58:32 +000073 buf_T *buf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +000074} vim_mz_buffer;
75
76#define INVALID_BUFFER_VALUE ((buf_T *)(-1))
77
78typedef struct
79{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +000080 Scheme_Object so;
Bram Moolenaar1d2ba7f2006-02-14 22:29:30 +000081 win_T *win;
Bram Moolenaar325b7a22004-07-05 15:58:32 +000082} vim_mz_window;
83
84#define INVALID_WINDOW_VALUE ((win_T *)(-1))
85
86/*
87 * Prims that form MzScheme Vim interface
88 */
89typedef struct
90{
91 Scheme_Closed_Prim *prim;
92 char *name;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +010093 int mina; // arity information
Bram Moolenaar325b7a22004-07-05 15:58:32 +000094 int maxa;
95} Vim_Prim;
96
97typedef struct
98{
99 char *name;
100 Scheme_Object *port;
101} Port_Info;
102
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000103/*
104 *========================================================================
105 * Vim-Control Commands
106 *========================================================================
107 */
108/*
109 *========================================================================
110 * Utility functions for the vim/mzscheme interface
111 *========================================================================
112 */
Bram Moolenaar555b2802005-05-19 21:08:39 +0000113#ifdef HAVE_SANDBOX
114static Scheme_Object *sandbox_file_guard(int, Scheme_Object **);
115static Scheme_Object *sandbox_network_guard(int, Scheme_Object **);
Bram Moolenaarc81e5e72007-05-05 18:24:42 +0000116static void sandbox_check(void);
Bram Moolenaar555b2802005-05-19 21:08:39 +0000117#endif
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100118// Buffer-related commands
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000119static Scheme_Object *buffer_new(buf_T *buf);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000120static Scheme_Object *get_buffer_by_num(void *, int, Scheme_Object **);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000121static vim_mz_buffer *get_vim_curr_buffer(void);
122
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100123// Window-related commands
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000124static Scheme_Object *window_new(win_T *win);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000125static vim_mz_window *get_vim_curr_window(void);
126
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000127/*
128 *========================================================================
129 * Internal Function Prototypes
130 *========================================================================
131 */
132static int vim_error_check(void);
133static int do_mzscheme_command(exarg_T *, void *, Scheme_Closed_Prim *what);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100134static int startup_mzscheme(void);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000135static char *string_to_line(Scheme_Object *obj);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100136#if MZSCHEME_VERSION_MAJOR >= 501
Bram Moolenaar75676462013-01-30 14:55:42 +0100137# define OUTPUT_LEN_TYPE intptr_t
138#else
139# define OUTPUT_LEN_TYPE long
140#endif
141static void do_output(char *mesg, OUTPUT_LEN_TYPE len);
Bram Moolenaar952d9d82021-08-02 18:07:18 +0200142static void do_printf(char *format, ...) ATTRIBUTE_FORMAT_PRINTF(1, 2);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000143static void do_flush(void);
144static Scheme_Object *_apply_thunk_catch_exceptions(
145 Scheme_Object *, Scheme_Object **);
146static Scheme_Object *extract_exn_message(Scheme_Object *v);
147static Scheme_Object *do_eval(void *, int noargc, Scheme_Object **noargv);
148static Scheme_Object *do_load(void *, int noargc, Scheme_Object **noargv);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000149static void register_vim_exn(void);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000150static vim_mz_buffer *get_buffer_arg(const char *fname, int argnum,
151 int argc, Scheme_Object **argv);
152static vim_mz_window *get_window_arg(const char *fname, int argnum,
153 int argc, Scheme_Object **argv);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000154static int line_in_range(linenr_T, buf_T *);
155static void check_line_range(linenr_T, buf_T *);
156static void mz_fix_cursor(int lo, int hi, int extra);
157
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000158static int eval_with_exn_handling(void *, Scheme_Closed_Prim *,
159 Scheme_Object **ret);
160static void make_modules(void);
161static void init_exn_catching_apply(void);
162static int mzscheme_env_main(Scheme_Env *env, int argc, char **argv);
163static int mzscheme_init(void);
164#ifdef FEAT_EVAL
Bram Moolenaar75676462013-01-30 14:55:42 +0100165static Scheme_Object *vim_to_mzscheme(typval_T *vim_value);
166static Scheme_Object *vim_to_mzscheme_impl(typval_T *vim_value, int depth,
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000167 Scheme_Hash_Table *visited);
Bram Moolenaar75676462013-01-30 14:55:42 +0100168static int mzscheme_to_vim(Scheme_Object *obj, typval_T *tv);
169static int mzscheme_to_vim_impl(Scheme_Object *obj, typval_T *tv, int depth,
Bram Moolenaar7e506b62010-01-19 15:55:06 +0100170 Scheme_Hash_Table *visited);
Bram Moolenaar75676462013-01-30 14:55:42 +0100171static Scheme_Object *vim_funcref(void *data, int argc, Scheme_Object **argv);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000172#endif
173
174#ifdef MZ_PRECISE_GC
Bram Moolenaar64404472010-06-26 06:24:45 +0200175static int buffer_size_proc(void *obj UNUSED)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000176{
177 return gcBYTES_TO_WORDS(sizeof(vim_mz_buffer));
178}
179static int buffer_mark_proc(void *obj)
180{
181 return buffer_size_proc(obj);
182}
183static int buffer_fixup_proc(void *obj)
184{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100185 // apparently not needed as the object will be uncollectable while
186 // the buffer is alive
187 // vim_mz_buffer* buf = (vim_mz_buffer*) obj;
188 // buf->buf->b_mzscheme_ref = GC_fixup_self(obj);
189
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000190 return buffer_size_proc(obj);
191}
Bram Moolenaar64404472010-06-26 06:24:45 +0200192static int window_size_proc(void *obj UNUSED)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000193{
194 return gcBYTES_TO_WORDS(sizeof(vim_mz_window));
195}
196static int window_mark_proc(void *obj)
197{
198 return window_size_proc(obj);
199}
200static int window_fixup_proc(void *obj)
201{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100202 // apparently not needed as the object will be uncollectable while
203 // the window is alive
204 // vim_mz_window* win = (vim_mz_window*) obj;
205 // win->win->w_mzscheme_ref = GC_fixup_self(obj);
206 //
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000207 return window_size_proc(obj);
208}
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100209// with precise GC, w_mzscheme_ref and b_mzscheme_ref are immobile boxes
210// containing pointers to a window/buffer
211// with conservative GC these are simply pointers
Bram Moolenaar75676462013-01-30 14:55:42 +0100212# define WINDOW_REF(win) *(vim_mz_window **)((win)->w_mzscheme_ref)
213# define BUFFER_REF(buf) *(vim_mz_buffer **)((buf)->b_mzscheme_ref)
214#else
215# define WINDOW_REF(win) (vim_mz_window *)((win)->w_mzscheme_ref)
216# define BUFFER_REF(buf) (vim_mz_buffer *)((buf)->b_mzscheme_ref)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000217#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000218
Bram Moolenaar4349c572016-01-30 13:28:28 +0100219#if defined(DYNAMIC_MZSCHEME) || defined(PROTO)
Bram Moolenaar33570922005-01-25 22:26:29 +0000220static Scheme_Object *dll_scheme_eof;
221static Scheme_Object *dll_scheme_false;
222static Scheme_Object *dll_scheme_void;
223static Scheme_Object *dll_scheme_null;
224static Scheme_Object *dll_scheme_true;
225
226static Scheme_Thread **dll_scheme_current_thread_ptr;
227
228static void (**dll_scheme_console_printf_ptr)(char *str, ...);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100229static void (**dll_scheme_console_output_ptr)(char *str, OUTPUT_LEN_TYPE len);
Bram Moolenaar33570922005-01-25 22:26:29 +0000230static void (**dll_scheme_notify_multithread_ptr)(int on);
231
232static void *(*dll_GC_malloc)(size_t size_in_bytes);
233static void *(*dll_GC_malloc_atomic)(size_t size_in_bytes);
234static Scheme_Env *(*dll_scheme_basic_env)(void);
235static void (*dll_scheme_check_threads)(void);
236static void (*dll_scheme_register_static)(void *ptr, long size);
237static void (*dll_scheme_set_stack_base)(void *base, int no_auto_statics);
238static void (*dll_scheme_add_global)(const char *name, Scheme_Object *val,
239 Scheme_Env *env);
240static void (*dll_scheme_add_global_symbol)(Scheme_Object *name,
241 Scheme_Object *val, Scheme_Env *env);
242static Scheme_Object *(*dll_scheme_apply)(Scheme_Object *rator, int num_rands,
243 Scheme_Object **rands);
244static Scheme_Object *(*dll_scheme_builtin_value)(const char *name);
Bram Moolenaar555b2802005-05-19 21:08:39 +0000245# if MZSCHEME_VERSION_MAJOR >= 299
246static Scheme_Object *(*dll_scheme_byte_string_to_char_string)(Scheme_Object *s);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100247static Scheme_Object *(*dll_scheme_make_path)(const char *chars);
Bram Moolenaar555b2802005-05-19 21:08:39 +0000248# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000249static void (*dll_scheme_close_input_port)(Scheme_Object *port);
250static void (*dll_scheme_count_lines)(Scheme_Object *port);
Bram Moolenaar049377e2007-05-12 15:32:12 +0000251#if MZSCHEME_VERSION_MAJOR < 360
Bram Moolenaar33570922005-01-25 22:26:29 +0000252static Scheme_Object *(*dll_scheme_current_continuation_marks)(void);
Bram Moolenaar049377e2007-05-12 15:32:12 +0000253#else
254static Scheme_Object *(*dll_scheme_current_continuation_marks)(Scheme_Object *prompt_tag);
255#endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000256static void (*dll_scheme_display)(Scheme_Object *obj, Scheme_Object *port);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100257static char *(*dll_scheme_display_to_string)(Scheme_Object *obj, OUTPUT_LEN_TYPE *len);
Bram Moolenaar555b2802005-05-19 21:08:39 +0000258static int (*dll_scheme_eq)(Scheme_Object *obj1, Scheme_Object *obj2);
Bram Moolenaar33570922005-01-25 22:26:29 +0000259static Scheme_Object *(*dll_scheme_do_eval)(Scheme_Object *obj,
260 int _num_rands, Scheme_Object **rands, int val);
261static void (*dll_scheme_dont_gc_ptr)(void *p);
262static Scheme_Object *(*dll_scheme_eval)(Scheme_Object *obj, Scheme_Env *env);
263static Scheme_Object *(*dll_scheme_eval_string)(const char *str,
264 Scheme_Env *env);
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000265static Scheme_Object *(*dll_scheme_eval_string_all)(const char *str,
Bram Moolenaar33570922005-01-25 22:26:29 +0000266 Scheme_Env *env, int all);
267static void (*dll_scheme_finish_primitive_module)(Scheme_Env *env);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000268# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar33570922005-01-25 22:26:29 +0000269static char *(*dll_scheme_format)(char *format, int flen, int argc,
270 Scheme_Object **argv, long *rlen);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000271# else
272static char *(*dll_scheme_format_utf8)(char *format, int flen, int argc,
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100273 Scheme_Object **argv, OUTPUT_LEN_TYPE *rlen);
Bram Moolenaar555b2802005-05-19 21:08:39 +0000274static Scheme_Object *(*dll_scheme_get_param)(Scheme_Config *c, int pos);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000275# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000276static void (*dll_scheme_gc_ptr_ok)(void *p);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000277# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar33570922005-01-25 22:26:29 +0000278static char *(*dll_scheme_get_sized_string_output)(Scheme_Object *,
279 long *len);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000280# else
281static char *(*dll_scheme_get_sized_byte_string_output)(Scheme_Object *,
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100282 OUTPUT_LEN_TYPE *len);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000283# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000284static Scheme_Object *(*dll_scheme_intern_symbol)(const char *name);
285static Scheme_Object *(*dll_scheme_lookup_global)(Scheme_Object *symbol,
286 Scheme_Env *env);
287static Scheme_Object *(*dll_scheme_make_closed_prim_w_arity)
288 (Scheme_Closed_Prim *prim, void *data, const char *name, mzshort mina,
289 mzshort maxa);
290static Scheme_Object *(*dll_scheme_make_integer_value)(long i);
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000291static Scheme_Object *(*dll_scheme_make_pair)(Scheme_Object *car,
Bram Moolenaar33570922005-01-25 22:26:29 +0000292 Scheme_Object *cdr);
Bram Moolenaar555b2802005-05-19 21:08:39 +0000293static Scheme_Object *(*dll_scheme_make_prim_w_arity)(Scheme_Prim *prim,
294 const char *name, mzshort mina, mzshort maxa);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000295# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar33570922005-01-25 22:26:29 +0000296static Scheme_Object *(*dll_scheme_make_string)(const char *chars);
297static Scheme_Object *(*dll_scheme_make_string_output_port)();
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000298# else
299static Scheme_Object *(*dll_scheme_make_byte_string)(const char *chars);
300static Scheme_Object *(*dll_scheme_make_byte_string_output_port)();
301# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000302static Scheme_Object *(*dll_scheme_make_struct_instance)(Scheme_Object *stype,
303 int argc, Scheme_Object **argv);
304static Scheme_Object **(*dll_scheme_make_struct_names)(Scheme_Object *base,
305 Scheme_Object *field_names, int flags, int *count_out);
306static Scheme_Object *(*dll_scheme_make_struct_type)(Scheme_Object *base,
307 Scheme_Object *parent, Scheme_Object *inspector, int num_fields,
308 int num_uninit_fields, Scheme_Object *uninit_val,
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000309 Scheme_Object *properties
310# if MZSCHEME_VERSION_MAJOR >= 299
311 , Scheme_Object *guard
312# endif
313 );
Bram Moolenaar33570922005-01-25 22:26:29 +0000314static Scheme_Object **(*dll_scheme_make_struct_values)(
315 Scheme_Object *struct_type, Scheme_Object **names, int count,
316 int flags);
317static Scheme_Type (*dll_scheme_make_type)(const char *name);
318static Scheme_Object *(*dll_scheme_make_vector)(int size,
319 Scheme_Object *fill);
320static void *(*dll_scheme_malloc_fail_ok)(void *(*f)(size_t), size_t);
321static Scheme_Object *(*dll_scheme_open_input_file)(const char *name,
322 const char *who);
323static Scheme_Env *(*dll_scheme_primitive_module)(Scheme_Object *name,
324 Scheme_Env *for_env);
325static int (*dll_scheme_proper_list_length)(Scheme_Object *list);
326static void (*dll_scheme_raise)(Scheme_Object *exn);
327static Scheme_Object *(*dll_scheme_read)(Scheme_Object *port);
328static void (*dll_scheme_signal_error)(const char *msg, ...);
329static void (*dll_scheme_wrong_type)(const char *name, const char *expected,
330 int which, int argc, Scheme_Object **argv);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000331# if MZSCHEME_VERSION_MAJOR >= 299
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000332static void (*dll_scheme_set_param)(Scheme_Config *c, int pos,
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000333 Scheme_Object *o);
334static Scheme_Config *(*dll_scheme_current_config)(void);
335static Scheme_Object *(*dll_scheme_char_string_to_byte_string)
336 (Scheme_Object *s);
Bram Moolenaare2a49d82007-07-06 17:43:08 +0000337static Scheme_Object *(*dll_scheme_char_string_to_path)
338 (Scheme_Object *s);
Bram Moolenaar75676462013-01-30 14:55:42 +0100339static void *(*dll_scheme_set_collects_path)(Scheme_Object *p);
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000340# endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000341static Scheme_Hash_Table *(*dll_scheme_make_hash_table)(int type);
342static void (*dll_scheme_hash_set)(Scheme_Hash_Table *table,
343 Scheme_Object *key, Scheme_Object *value);
344static Scheme_Object *(*dll_scheme_hash_get)(Scheme_Hash_Table *table,
345 Scheme_Object *key);
346static Scheme_Object *(*dll_scheme_make_double)(double d);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000347static Scheme_Object *(*dll_scheme_make_sized_byte_string)(char *chars,
348 long len, int copy);
349static Scheme_Object *(*dll_scheme_namespace_require)(Scheme_Object *req);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100350static Scheme_Object *(*dll_scheme_dynamic_wind)(void (*pre)(void *), Scheme_Object *(* volatile act)(void *), void (* volatile post)(void *), Scheme_Object *(*jmp_handler)(void *), void * volatile data);
351# ifdef MZ_PRECISE_GC
352static void *(*dll_GC_malloc_one_tagged)(size_t size_in_bytes);
353static void (*dll_GC_register_traversers)(short tag, Size_Proc size, Mark_Proc mark, Fixup_Proc fixup, int is_constant_size, int is_atomic);
354# endif
355# if MZSCHEME_VERSION_MAJOR >= 400
356static void (*dll_scheme_init_collection_paths)(Scheme_Env *global_env, Scheme_Object *extra_dirs);
357static void **(*dll_scheme_malloc_immobile_box)(void *p);
358static void (*dll_scheme_free_immobile_box)(void **b);
359# endif
360# if MZSCHEME_VERSION_MAJOR >= 500
361# ifdef TRAMPOLINED_MZVIM_STARTUP
362static int (*dll_scheme_main_setup)(int no_auto_statics, Scheme_Env_Main _main, int argc, char **argv);
363# if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
364static void (*dll_scheme_register_tls_space)(void *tls_space, int _tls_index);
365# endif
366# endif
367# if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
368static Thread_Local_Variables *(*dll_scheme_external_get_thread_local_variables)(void);
369# endif
370# endif
371# if MZSCHEME_VERSION_MAJOR >= 600
372static void (*dll_scheme_embedded_load)(intptr_t len, const char *s, int predefined);
373static void (*dll_scheme_register_embedded_load)(intptr_t len, const char *s);
374static void (*dll_scheme_set_config_path)(Scheme_Object *p);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000375# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000376
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100377#if defined(DYNAMIC_MZSCHEME) // not when defined(PROTO)
Bram Moolenaar4349c572016-01-30 13:28:28 +0100378
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100379// arrays are imported directly
Bram Moolenaar33570922005-01-25 22:26:29 +0000380# define scheme_eof dll_scheme_eof
381# define scheme_false dll_scheme_false
382# define scheme_void dll_scheme_void
383# define scheme_null dll_scheme_null
384# define scheme_true dll_scheme_true
385
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100386// pointers are GetProceAddress'ed as pointers to pointer
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100387#if !defined(USE_THREAD_LOCAL) && !defined(LINK_EXTENSIONS_BY_TABLE)
388# define scheme_current_thread (*dll_scheme_current_thread_ptr)
389# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000390# define scheme_console_printf (*dll_scheme_console_printf_ptr)
391# define scheme_console_output (*dll_scheme_console_output_ptr)
392# define scheme_notify_multithread (*dll_scheme_notify_multithread_ptr)
393
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100394// and functions in a usual way
Bram Moolenaar33570922005-01-25 22:26:29 +0000395# define GC_malloc dll_GC_malloc
396# define GC_malloc_atomic dll_GC_malloc_atomic
397
398# define scheme_add_global dll_scheme_add_global
399# define scheme_add_global_symbol dll_scheme_add_global_symbol
400# define scheme_apply dll_scheme_apply
401# define scheme_basic_env dll_scheme_basic_env
402# define scheme_builtin_value dll_scheme_builtin_value
Bram Moolenaar555b2802005-05-19 21:08:39 +0000403# if MZSCHEME_VERSION_MAJOR >= 299
404# define scheme_byte_string_to_char_string dll_scheme_byte_string_to_char_string
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100405# define scheme_make_path dll_scheme_make_path
Bram Moolenaar555b2802005-05-19 21:08:39 +0000406# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000407# define scheme_check_threads dll_scheme_check_threads
408# define scheme_close_input_port dll_scheme_close_input_port
409# define scheme_count_lines dll_scheme_count_lines
410# define scheme_current_continuation_marks \
411 dll_scheme_current_continuation_marks
412# define scheme_display dll_scheme_display
413# define scheme_display_to_string dll_scheme_display_to_string
414# define scheme_do_eval dll_scheme_do_eval
415# define scheme_dont_gc_ptr dll_scheme_dont_gc_ptr
Bram Moolenaar555b2802005-05-19 21:08:39 +0000416# define scheme_eq dll_scheme_eq
Bram Moolenaar33570922005-01-25 22:26:29 +0000417# define scheme_eval dll_scheme_eval
418# define scheme_eval_string dll_scheme_eval_string
419# define scheme_eval_string_all dll_scheme_eval_string_all
420# define scheme_finish_primitive_module dll_scheme_finish_primitive_module
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000421# if MZSCHEME_VERSION_MAJOR < 299
422# define scheme_format dll_scheme_format
423# else
424# define scheme_format_utf8 dll_scheme_format_utf8
425# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000426# define scheme_gc_ptr_ok dll_scheme_gc_ptr_ok
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000427# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar75676462013-01-30 14:55:42 +0100428# define scheme_get_sized_byte_string_output dll_scheme_get_sized_string_output
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000429# else
430# define scheme_get_sized_byte_string_output \
431 dll_scheme_get_sized_byte_string_output
Bram Moolenaar75676462013-01-30 14:55:42 +0100432# define scheme_get_param dll_scheme_get_param
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000433# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000434# define scheme_intern_symbol dll_scheme_intern_symbol
435# define scheme_lookup_global dll_scheme_lookup_global
436# define scheme_make_closed_prim_w_arity dll_scheme_make_closed_prim_w_arity
437# define scheme_make_integer_value dll_scheme_make_integer_value
Bram Moolenaar33570922005-01-25 22:26:29 +0000438# define scheme_make_pair dll_scheme_make_pair
Bram Moolenaar555b2802005-05-19 21:08:39 +0000439# define scheme_make_prim_w_arity dll_scheme_make_prim_w_arity
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000440# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar75676462013-01-30 14:55:42 +0100441# define scheme_make_byte_string dll_scheme_make_string
442# define scheme_make_byte_string_output_port dll_scheme_make_string_output_port
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000443# else
444# define scheme_make_byte_string dll_scheme_make_byte_string
445# define scheme_make_byte_string_output_port \
446 dll_scheme_make_byte_string_output_port
447# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000448# define scheme_make_struct_instance dll_scheme_make_struct_instance
449# define scheme_make_struct_names dll_scheme_make_struct_names
450# define scheme_make_struct_type dll_scheme_make_struct_type
451# define scheme_make_struct_values dll_scheme_make_struct_values
452# define scheme_make_type dll_scheme_make_type
453# define scheme_make_vector dll_scheme_make_vector
454# define scheme_malloc_fail_ok dll_scheme_malloc_fail_ok
455# define scheme_open_input_file dll_scheme_open_input_file
456# define scheme_primitive_module dll_scheme_primitive_module
457# define scheme_proper_list_length dll_scheme_proper_list_length
458# define scheme_raise dll_scheme_raise
459# define scheme_read dll_scheme_read
460# define scheme_register_static dll_scheme_register_static
461# define scheme_set_stack_base dll_scheme_set_stack_base
462# define scheme_signal_error dll_scheme_signal_error
463# define scheme_wrong_type dll_scheme_wrong_type
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000464# if MZSCHEME_VERSION_MAJOR >= 299
465# define scheme_set_param dll_scheme_set_param
466# define scheme_current_config dll_scheme_current_config
467# define scheme_char_string_to_byte_string \
468 dll_scheme_char_string_to_byte_string
Bram Moolenaare2a49d82007-07-06 17:43:08 +0000469# define scheme_char_string_to_path \
470 dll_scheme_char_string_to_path
Bram Moolenaar75676462013-01-30 14:55:42 +0100471# define scheme_set_collects_path dll_scheme_set_collects_path
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000472# endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000473# define scheme_make_hash_table dll_scheme_make_hash_table
474# define scheme_hash_set dll_scheme_hash_set
475# define scheme_hash_get dll_scheme_hash_get
476# define scheme_make_double dll_scheme_make_double
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100477# define scheme_make_sized_byte_string dll_scheme_make_sized_byte_string
478# define scheme_namespace_require dll_scheme_namespace_require
479# define scheme_dynamic_wind dll_scheme_dynamic_wind
480# ifdef MZ_PRECISE_GC
481# define GC_malloc_one_tagged dll_GC_malloc_one_tagged
482# define GC_register_traversers dll_GC_register_traversers
483# endif
484# if MZSCHEME_VERSION_MAJOR >= 400
485# ifdef TRAMPOLINED_MZVIM_STARTUP
486# define scheme_main_setup dll_scheme_main_setup
487# if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
488# define scheme_register_tls_space dll_scheme_register_tls_space
489# endif
490# endif
491# define scheme_init_collection_paths dll_scheme_init_collection_paths
492# define scheme_malloc_immobile_box dll_scheme_malloc_immobile_box
493# define scheme_free_immobile_box dll_scheme_free_immobile_box
494# endif
495# if MZSCHEME_VERSION_MAJOR >= 600
496# define scheme_embedded_load dll_scheme_embedded_load
497# define scheme_register_embedded_load dll_scheme_register_embedded_load
498# define scheme_set_config_path dll_scheme_set_config_path
499# endif
500
501# if MZSCHEME_VERSION_MAJOR >= 500
502# if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100503// define as function for macro in schthread.h
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100504Thread_Local_Variables *
505scheme_external_get_thread_local_variables(void)
506{
507 return dll_scheme_external_get_thread_local_variables();
508}
509# endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000510# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000511
Bram Moolenaar4349c572016-01-30 13:28:28 +0100512#endif
513
Bram Moolenaar33570922005-01-25 22:26:29 +0000514typedef struct
515{
516 char *name;
517 void **ptr;
518} Thunk_Info;
519
520static Thunk_Info mzgc_imports[] = {
521 {"GC_malloc", (void **)&dll_GC_malloc},
522 {"GC_malloc_atomic", (void **)&dll_GC_malloc_atomic},
523 {NULL, NULL}};
524
525static Thunk_Info mzsch_imports[] = {
526 {"scheme_eof", (void **)&dll_scheme_eof},
527 {"scheme_false", (void **)&dll_scheme_false},
528 {"scheme_void", (void **)&dll_scheme_void},
529 {"scheme_null", (void **)&dll_scheme_null},
530 {"scheme_true", (void **)&dll_scheme_true},
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100531#if !defined(USE_THREAD_LOCAL) && !defined(LINK_EXTENSIONS_BY_TABLE)
Bram Moolenaar33570922005-01-25 22:26:29 +0000532 {"scheme_current_thread", (void **)&dll_scheme_current_thread_ptr},
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100533#endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000534 {"scheme_console_printf", (void **)&dll_scheme_console_printf_ptr},
535 {"scheme_console_output", (void **)&dll_scheme_console_output_ptr},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000536 {"scheme_notify_multithread",
Bram Moolenaar33570922005-01-25 22:26:29 +0000537 (void **)&dll_scheme_notify_multithread_ptr},
538 {"scheme_add_global", (void **)&dll_scheme_add_global},
539 {"scheme_add_global_symbol", (void **)&dll_scheme_add_global_symbol},
540 {"scheme_apply", (void **)&dll_scheme_apply},
541 {"scheme_basic_env", (void **)&dll_scheme_basic_env},
Bram Moolenaar555b2802005-05-19 21:08:39 +0000542# if MZSCHEME_VERSION_MAJOR >= 299
543 {"scheme_byte_string_to_char_string", (void **)&dll_scheme_byte_string_to_char_string},
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100544 {"scheme_make_path", (void **)&dll_scheme_make_path},
Bram Moolenaar555b2802005-05-19 21:08:39 +0000545# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000546 {"scheme_builtin_value", (void **)&dll_scheme_builtin_value},
547 {"scheme_check_threads", (void **)&dll_scheme_check_threads},
548 {"scheme_close_input_port", (void **)&dll_scheme_close_input_port},
549 {"scheme_count_lines", (void **)&dll_scheme_count_lines},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000550 {"scheme_current_continuation_marks",
Bram Moolenaar33570922005-01-25 22:26:29 +0000551 (void **)&dll_scheme_current_continuation_marks},
552 {"scheme_display", (void **)&dll_scheme_display},
553 {"scheme_display_to_string", (void **)&dll_scheme_display_to_string},
554 {"scheme_do_eval", (void **)&dll_scheme_do_eval},
555 {"scheme_dont_gc_ptr", (void **)&dll_scheme_dont_gc_ptr},
Bram Moolenaar555b2802005-05-19 21:08:39 +0000556 {"scheme_eq", (void **)&dll_scheme_eq},
Bram Moolenaar33570922005-01-25 22:26:29 +0000557 {"scheme_eval", (void **)&dll_scheme_eval},
558 {"scheme_eval_string", (void **)&dll_scheme_eval_string},
559 {"scheme_eval_string_all", (void **)&dll_scheme_eval_string_all},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000560 {"scheme_finish_primitive_module",
Bram Moolenaar33570922005-01-25 22:26:29 +0000561 (void **)&dll_scheme_finish_primitive_module},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000562# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar33570922005-01-25 22:26:29 +0000563 {"scheme_format", (void **)&dll_scheme_format},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000564# else
565 {"scheme_format_utf8", (void **)&dll_scheme_format_utf8},
Bram Moolenaar555b2802005-05-19 21:08:39 +0000566 {"scheme_get_param", (void **)&dll_scheme_get_param},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000567#endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000568 {"scheme_gc_ptr_ok", (void **)&dll_scheme_gc_ptr_ok},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000569# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000570 {"scheme_get_sized_string_output",
Bram Moolenaar33570922005-01-25 22:26:29 +0000571 (void **)&dll_scheme_get_sized_string_output},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000572# else
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000573 {"scheme_get_sized_byte_string_output",
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000574 (void **)&dll_scheme_get_sized_byte_string_output},
575#endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000576 {"scheme_intern_symbol", (void **)&dll_scheme_intern_symbol},
577 {"scheme_lookup_global", (void **)&dll_scheme_lookup_global},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000578 {"scheme_make_closed_prim_w_arity",
Bram Moolenaar33570922005-01-25 22:26:29 +0000579 (void **)&dll_scheme_make_closed_prim_w_arity},
580 {"scheme_make_integer_value", (void **)&dll_scheme_make_integer_value},
Bram Moolenaar33570922005-01-25 22:26:29 +0000581 {"scheme_make_pair", (void **)&dll_scheme_make_pair},
Bram Moolenaar555b2802005-05-19 21:08:39 +0000582 {"scheme_make_prim_w_arity", (void **)&dll_scheme_make_prim_w_arity},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000583# if MZSCHEME_VERSION_MAJOR < 299
Bram Moolenaar33570922005-01-25 22:26:29 +0000584 {"scheme_make_string", (void **)&dll_scheme_make_string},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000585 {"scheme_make_string_output_port",
Bram Moolenaar33570922005-01-25 22:26:29 +0000586 (void **)&dll_scheme_make_string_output_port},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000587# else
588 {"scheme_make_byte_string", (void **)&dll_scheme_make_byte_string},
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000589 {"scheme_make_byte_string_output_port",
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000590 (void **)&dll_scheme_make_byte_string_output_port},
591# endif
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000592 {"scheme_make_struct_instance",
Bram Moolenaar33570922005-01-25 22:26:29 +0000593 (void **)&dll_scheme_make_struct_instance},
594 {"scheme_make_struct_names", (void **)&dll_scheme_make_struct_names},
595 {"scheme_make_struct_type", (void **)&dll_scheme_make_struct_type},
596 {"scheme_make_struct_values", (void **)&dll_scheme_make_struct_values},
597 {"scheme_make_type", (void **)&dll_scheme_make_type},
598 {"scheme_make_vector", (void **)&dll_scheme_make_vector},
599 {"scheme_malloc_fail_ok", (void **)&dll_scheme_malloc_fail_ok},
600 {"scheme_open_input_file", (void **)&dll_scheme_open_input_file},
601 {"scheme_primitive_module", (void **)&dll_scheme_primitive_module},
602 {"scheme_proper_list_length", (void **)&dll_scheme_proper_list_length},
603 {"scheme_raise", (void **)&dll_scheme_raise},
604 {"scheme_read", (void **)&dll_scheme_read},
605 {"scheme_register_static", (void **)&dll_scheme_register_static},
606 {"scheme_set_stack_base", (void **)&dll_scheme_set_stack_base},
607 {"scheme_signal_error", (void **)&dll_scheme_signal_error},
608 {"scheme_wrong_type", (void **)&dll_scheme_wrong_type},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000609# if MZSCHEME_VERSION_MAJOR >= 299
610 {"scheme_set_param", (void **)&dll_scheme_set_param},
611 {"scheme_current_config", (void **)&dll_scheme_current_config},
612 {"scheme_char_string_to_byte_string",
613 (void **)&dll_scheme_char_string_to_byte_string},
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000614 {"scheme_char_string_to_path", (void **)&dll_scheme_char_string_to_path},
Bram Moolenaar75676462013-01-30 14:55:42 +0100615 {"scheme_set_collects_path", (void **)&dll_scheme_set_collects_path},
Bram Moolenaar2e6aff32005-01-31 19:25:36 +0000616# endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000617 {"scheme_make_hash_table", (void **)&dll_scheme_make_hash_table},
618 {"scheme_hash_set", (void **)&dll_scheme_hash_set},
619 {"scheme_hash_get", (void **)&dll_scheme_hash_get},
620 {"scheme_make_double", (void **)&dll_scheme_make_double},
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000621 {"scheme_make_sized_byte_string", (void **)&dll_scheme_make_sized_byte_string},
622 {"scheme_namespace_require", (void **)&dll_scheme_namespace_require},
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100623 {"scheme_dynamic_wind", (void **)&dll_scheme_dynamic_wind},
624# ifdef MZ_PRECISE_GC
625 {"GC_malloc_one_tagged", (void **)&dll_GC_malloc_one_tagged},
626 {"GC_register_traversers", (void **)&dll_GC_register_traversers},
627# endif
628# if MZSCHEME_VERSION_MAJOR >= 400
629# ifdef TRAMPOLINED_MZVIM_STARTUP
630 {"scheme_main_setup", (void **)&dll_scheme_main_setup},
631# if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
632 {"scheme_register_tls_space", (void **)&dll_scheme_register_tls_space},
633# endif
634# endif
635 {"scheme_init_collection_paths", (void **)&dll_scheme_init_collection_paths},
636 {"scheme_malloc_immobile_box", (void **)&dll_scheme_malloc_immobile_box},
637 {"scheme_free_immobile_box", (void **)&dll_scheme_free_immobile_box},
638# endif
639# if MZSCHEME_VERSION_MAJOR >= 500
640# if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
641 {"scheme_external_get_thread_local_variables", (void **)&dll_scheme_external_get_thread_local_variables},
642# endif
643# endif
644# if MZSCHEME_VERSION_MAJOR >= 600
645 {"scheme_embedded_load", (void **)&dll_scheme_embedded_load},
646 {"scheme_register_embedded_load", (void **)&dll_scheme_register_embedded_load},
647 {"scheme_set_config_path", (void **)&dll_scheme_set_config_path},
648# endif
Bram Moolenaar33570922005-01-25 22:26:29 +0000649 {NULL, NULL}};
650
651static HINSTANCE hMzGC = 0;
652static HINSTANCE hMzSch = 0;
653
654static void dynamic_mzscheme_end(void);
655static int mzscheme_runtime_link_init(char *sch_dll, char *gc_dll,
656 int verbose);
657
658 static int
659mzscheme_runtime_link_init(char *sch_dll, char *gc_dll, int verbose)
660{
661 Thunk_Info *thunk = NULL;
662
663 if (hMzGC && hMzSch)
664 return OK;
Bram Moolenaarebbcb822010-10-23 14:02:54 +0200665 hMzSch = vimLoadLib(sch_dll);
666 hMzGC = vimLoadLib(gc_dll);
Bram Moolenaar33570922005-01-25 22:26:29 +0000667
Bram Moolenaar33570922005-01-25 22:26:29 +0000668 if (!hMzGC)
669 {
670 if (verbose)
Bram Moolenaar460ae5d2022-01-01 14:19:49 +0000671 semsg(_(e_could_not_load_library_str_str), gc_dll, GetWin32Error());
Bram Moolenaar33570922005-01-25 22:26:29 +0000672 return FAIL;
673 }
674
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100675 if (!hMzSch)
676 {
677 if (verbose)
Bram Moolenaar460ae5d2022-01-01 14:19:49 +0000678 semsg(_(e_could_not_load_library_str_str), sch_dll, GetWin32Error());
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100679 return FAIL;
680 }
681
Bram Moolenaar33570922005-01-25 22:26:29 +0000682 for (thunk = mzsch_imports; thunk->name; thunk++)
683 {
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000684 if ((*thunk->ptr =
Bram Moolenaar33570922005-01-25 22:26:29 +0000685 (void *)GetProcAddress(hMzSch, thunk->name)) == NULL)
686 {
687 FreeLibrary(hMzSch);
688 hMzSch = 0;
689 FreeLibrary(hMzGC);
690 hMzGC = 0;
691 if (verbose)
Bram Moolenaar460ae5d2022-01-01 14:19:49 +0000692 semsg(_(e_could_not_load_library_function_str), thunk->name);
Bram Moolenaar33570922005-01-25 22:26:29 +0000693 return FAIL;
694 }
695 }
696 for (thunk = mzgc_imports; thunk->name; thunk++)
697 {
Bram Moolenaard857f0e2005-06-21 22:37:39 +0000698 if ((*thunk->ptr =
Bram Moolenaar33570922005-01-25 22:26:29 +0000699 (void *)GetProcAddress(hMzGC, thunk->name)) == NULL)
700 {
701 FreeLibrary(hMzSch);
702 hMzSch = 0;
703 FreeLibrary(hMzGC);
704 hMzGC = 0;
705 if (verbose)
Bram Moolenaar460ae5d2022-01-01 14:19:49 +0000706 semsg(_(e_could_not_load_library_function_str), thunk->name);
Bram Moolenaar33570922005-01-25 22:26:29 +0000707 return FAIL;
708 }
709 }
710 return OK;
711}
712
713 int
714mzscheme_enabled(int verbose)
715{
716 return mzscheme_runtime_link_init(
Bram Moolenaar0ab35b22017-10-08 17:41:37 +0200717 (char *)p_mzschemedll, (char *)p_mzschemegcdll, verbose) == OK;
Bram Moolenaar33570922005-01-25 22:26:29 +0000718}
719
720 static void
721dynamic_mzscheme_end(void)
722{
723 if (hMzSch)
724 {
725 FreeLibrary(hMzSch);
726 hMzSch = 0;
727 }
728 if (hMzGC)
729 {
730 FreeLibrary(hMzGC);
731 hMzGC = 0;
732 }
733}
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100734#endif // DYNAMIC_MZSCHEME
Bram Moolenaar33570922005-01-25 22:26:29 +0000735
Bram Moolenaar75676462013-01-30 14:55:42 +0100736#if MZSCHEME_VERSION_MAJOR < 299
737# define GUARANTEED_STRING_ARG(proc, num) GUARANTEE_STRING(proc, num)
738#else
739 static Scheme_Object *
740guaranteed_byte_string_arg(char *proc, int num, int argc, Scheme_Object **argv)
741{
742 if (SCHEME_BYTE_STRINGP(argv[num]))
743 {
744 return argv[num];
745 }
746 else if (SCHEME_CHAR_STRINGP(argv[num]))
747 {
748 Scheme_Object *tmp = NULL;
749 MZ_GC_DECL_REG(2);
750 MZ_GC_VAR_IN_REG(0, argv[num]);
751 MZ_GC_VAR_IN_REG(1, tmp);
752 MZ_GC_REG();
753 tmp = scheme_char_string_to_byte_string(argv[num]);
754 MZ_GC_UNREG();
755 return tmp;
756 }
757 else
758 scheme_wrong_type(proc, "string", num, argc, argv);
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100759 // unreachable
Bram Moolenaar75676462013-01-30 14:55:42 +0100760 return scheme_void;
761}
762# define GUARANTEED_STRING_ARG(proc, num) guaranteed_byte_string_arg(proc, num, argc, argv)
763#endif
764
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100765// need to put it here for dynamic stuff to work
Bram Moolenaare484c942009-09-11 10:21:41 +0000766#if defined(INCLUDE_MZSCHEME_BASE)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000767# include "mzscheme_base.c"
768#endif
769
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000770/*
771 *========================================================================
772 * 1. MzScheme interpreter startup
773 *========================================================================
774 */
775
776static Scheme_Type mz_buffer_type;
777static Scheme_Type mz_window_type;
778
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000779static int initialized = FALSE;
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100780#ifdef DYNAMIC_MZSCHEME
781static int disabled = FALSE;
782#endif
783static int load_base_module_failed = FALSE;
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000784
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100785// global environment
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000786static Scheme_Env *environment = NULL;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100787// output/error handlers
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000788static Scheme_Object *curout = NULL;
789static Scheme_Object *curerr = NULL;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100790// exn:vim exception
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000791static Scheme_Object *exn_catching_apply = NULL;
792static Scheme_Object *exn_p = NULL;
793static Scheme_Object *exn_message = NULL;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100794static Scheme_Object *vim_exn = NULL; // Vim Error exception
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000795
796#if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400
797static void *stack_base = NULL;
798#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000799
800static long range_start;
801static long range_end;
802
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100803// MzScheme threads scheduling stuff
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000804static int mz_threads_allow = 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000805
Bram Moolenaar4f974752019-02-17 17:44:42 +0100806#if defined(FEAT_GUI_MSWIN)
Bram Moolenaardec6c7b2016-06-02 11:57:38 +0200807static void CALLBACK timer_proc(HWND, UINT, UINT_PTR, DWORD);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000808static UINT timer_id = 0;
809#elif defined(FEAT_GUI_GTK)
Bram Moolenaar98921892016-02-23 17:14:37 +0100810static gboolean timer_proc(gpointer);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000811static guint timer_id = 0;
Bram Moolenaar0b962e52022-04-03 18:02:37 +0100812#elif defined(FEAT_GUI_MOTIF)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000813static void timer_proc(XtPointer, XtIntervalId *);
814static XtIntervalId timer_id = (XtIntervalId)0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000815#endif
816
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100817#if !defined(FEAT_GUI_MSWIN) || defined(VIMDLL) // Win32 console and Unix
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000818 void
819mzvim_check_threads(void)
820{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100821 // Last time MzScheme threads were scheduled
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000822 static time_t mz_last_time = 0;
823
824 if (mz_threads_allow && p_mzq > 0)
825 {
826 time_t now = time(NULL);
827
828 if ((now - mz_last_time) * 1000 > p_mzq)
829 {
830 mz_last_time = now;
831 scheme_check_threads();
832 }
833 }
834}
835#endif
836
Bram Moolenaar4349c572016-01-30 13:28:28 +0100837#if defined(MZSCHEME_GUI_THREADS) || defined(PROTO)
Bram Moolenaar2df6dcc2004-07-12 15:53:54 +0000838static void setup_timer(void);
839static void remove_timer(void);
840
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100841// timers are presented in GUI only
Bram Moolenaar4f974752019-02-17 17:44:42 +0100842# if defined(FEAT_GUI_MSWIN)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000843 static void CALLBACK
Bram Moolenaar9b0ac222016-06-01 20:31:43 +0200844timer_proc(HWND hwnd UNUSED, UINT uMsg UNUSED, UINT_PTR idEvent UNUSED, DWORD dwTime UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000845# elif defined(FEAT_GUI_GTK)
Bram Moolenaar98921892016-02-23 17:14:37 +0100846 static gboolean
Bram Moolenaar64404472010-06-26 06:24:45 +0200847timer_proc(gpointer data UNUSED)
Bram Moolenaar0b962e52022-04-03 18:02:37 +0100848# elif defined(FEAT_GUI_MOTIF)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000849 static void
Bram Moolenaar64404472010-06-26 06:24:45 +0200850timer_proc(XtPointer timed_out UNUSED, XtIntervalId *interval_id UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000851# endif
852{
853 scheme_check_threads();
854# if defined(FEAT_GUI_GTK)
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100855 return TRUE; // continue receiving notifications
Bram Moolenaar0b962e52022-04-03 18:02:37 +0100856# elif defined(FEAT_GUI_MOTIF)
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100857 // renew timeout
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000858 if (mz_threads_allow && p_mzq > 0)
859 timer_id = XtAppAddTimeOut(app_context, p_mzq,
860 timer_proc, NULL);
861# endif
862}
863
864 static void
865setup_timer(void)
866{
Bram Moolenaar4f974752019-02-17 17:44:42 +0100867# if defined(FEAT_GUI_MSWIN)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000868 timer_id = SetTimer(NULL, 0, p_mzq, timer_proc);
869# elif defined(FEAT_GUI_GTK)
Bram Moolenaar98921892016-02-23 17:14:37 +0100870 timer_id = g_timeout_add((guint)p_mzq, (GSourceFunc)timer_proc, NULL);
Bram Moolenaar0b962e52022-04-03 18:02:37 +0100871# elif defined(FEAT_GUI_MOTIF)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000872 timer_id = XtAppAddTimeOut(app_context, p_mzq, timer_proc, NULL);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000873# endif
874}
875
876 static void
877remove_timer(void)
878{
Bram Moolenaar4f974752019-02-17 17:44:42 +0100879# if defined(FEAT_GUI_MSWIN)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000880 KillTimer(NULL, timer_id);
881# elif defined(FEAT_GUI_GTK)
Bram Moolenaar98921892016-02-23 17:14:37 +0100882 g_source_remove(timer_id);
Bram Moolenaar0b962e52022-04-03 18:02:37 +0100883# elif defined(FEAT_GUI_MOTIF)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000884 XtRemoveTimeOut(timer_id);
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000885# endif
886 timer_id = 0;
887}
888
K.Takata4ee083e2023-02-22 13:14:36 +0000889#endif // MZSCHEME_GUI_THREADS
890
Yegappan Lakshmananaf936912023-02-20 12:16:39 +0000891 char *
K.Takata4ee083e2023-02-22 13:14:36 +0000892did_set_mzquantum(optset_T *args UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000893{
K.Takata4ee083e2023-02-22 13:14:36 +0000894#if defined(MZSCHEME_GUI_THREADS)
Yegappan Lakshmananaf936912023-02-20 12:16:39 +0000895 // reset timer
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000896 if (timer_id != 0)
897 remove_timer();
898 if (mz_threads_allow && p_mzq > 0 && gui.in_use)
899 setup_timer();
K.Takata4ee083e2023-02-22 13:14:36 +0000900#endif
Yegappan Lakshmananaf936912023-02-20 12:16:39 +0000901 return NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000902}
903
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000904 static void
905notify_multithread(int on)
906{
907 mz_threads_allow = on;
Bram Moolenaar2df6dcc2004-07-12 15:53:54 +0000908#ifdef MZSCHEME_GUI_THREADS
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000909 if (on && timer_id == 0 && p_mzq > 0 && gui.in_use)
910 setup_timer();
911 if (!on && timer_id != 0)
912 remove_timer();
913#endif
914}
915
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000916 void
917mzscheme_end(void)
918{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100919 // We can not unload the DLL. Racket's thread might be still alive.
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100920#if 0
Bram Moolenaar33570922005-01-25 22:26:29 +0000921#ifdef DYNAMIC_MZSCHEME
922 dynamic_mzscheme_end();
923#endif
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100924#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000925}
926
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100927#if HAVE_TLS_SPACE
928# if defined(_MSC_VER)
Bram Moolenaar2d0860d2010-11-03 21:59:30 +0100929static __declspec(thread) void *tls_space;
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100930extern intptr_t _tls_index;
931# elif defined(__MINGW32__)
932static __thread void *tls_space;
933extern intptr_t _tls_index;
934# else
935static THREAD_LOCAL void *tls_space;
936static intptr_t _tls_index = 0;
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100937# endif
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100938#endif
939
Bram Moolenaar54b63522016-08-26 12:55:09 +0200940/*
941 * mzscheme_main() is called early in main().
942 * We may call scheme_main_setup() which calls mzscheme_env_main() which then
943 * trampolines into vim_main2(), which never returns.
944 */
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100945 int
Bram Moolenaar54b63522016-08-26 12:55:09 +0200946mzscheme_main(void)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000947{
Bram Moolenaara8e691d2016-08-07 15:19:26 +0200948 int argc = 0;
949 char *argv = NULL;
950
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100951#ifdef DYNAMIC_MZSCHEME
952 /*
953 * Racket requires trampolined startup. We can not load it later.
954 * If dynamic dll loading is failed, disable it.
955 */
956 if (!mzscheme_enabled(FALSE))
957 {
958 disabled = TRUE;
Bram Moolenaara8e691d2016-08-07 15:19:26 +0200959 return vim_main2();
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100960 }
961#endif
Bram Moolenaar5c5c9802015-07-10 16:12:48 +0200962#ifdef HAVE_TLS_SPACE
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100963 scheme_register_tls_space(&tls_space, _tls_index);
Bram Moolenaar2d0860d2010-11-03 21:59:30 +0100964#endif
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100965#ifdef TRAMPOLINED_MZVIM_STARTUP
Bram Moolenaara8e691d2016-08-07 15:19:26 +0200966 return scheme_main_setup(TRUE, mzscheme_env_main, argc, &argv);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000967#else
Bram Moolenaara8e691d2016-08-07 15:19:26 +0200968 return mzscheme_env_main(NULL, argc, &argv);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000969#endif
970}
971
972 static int
Bram Moolenaar54b63522016-08-26 12:55:09 +0200973mzscheme_env_main(Scheme_Env *env, int argc UNUSED, char **argv UNUSED)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000974{
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100975#ifdef TRAMPOLINED_MZVIM_STARTUP
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100976 // Scheme has created the environment for us
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100977 environment = env;
978#else
979# ifdef MZ_PRECISE_GC
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000980 Scheme_Object *dummy = NULL;
981 MZ_GC_DECL_REG(1);
982 MZ_GC_VAR_IN_REG(0, dummy);
983
984 stack_base = &__gc_var_stack__;
985# else
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000986 int dummy = 0;
987 stack_base = (void *)&dummy;
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100988# endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000989#endif
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100990
Bram Moolenaar54b63522016-08-26 12:55:09 +0200991 vim_main2();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100992 // not reached, vim_main2() will loop until exit()
Bram Moolenaar54b63522016-08-26 12:55:09 +0200993
994 return 0;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000995}
996
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100997 static Scheme_Object*
998load_base_module(void *data)
999{
1000 scheme_namespace_require(scheme_intern_symbol((char *)data));
1001 return scheme_null;
1002}
1003
1004 static Scheme_Object *
Bram Moolenaar8b29aba2016-03-28 22:17:16 +02001005load_base_module_on_error(void *data UNUSED)
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001006{
1007 load_base_module_failed = TRUE;
1008 return scheme_null;
1009}
1010
1011 static int
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001012startup_mzscheme(void)
1013{
Bram Moolenaarbbc98db2012-02-12 01:55:55 +01001014#ifndef TRAMPOLINED_MZVIM_STARTUP
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001015 scheme_set_stack_base(stack_base, 1);
1016#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001017
Bram Moolenaar75676462013-01-30 14:55:42 +01001018#ifndef TRAMPOLINED_MZVIM_STARTUP
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001019 // in newer versions of precise GC the initial env has been created
Bram Moolenaar75676462013-01-30 14:55:42 +01001020 environment = scheme_basic_env();
1021#endif
1022
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001023 MZ_REGISTER_STATIC(environment);
1024 MZ_REGISTER_STATIC(curout);
1025 MZ_REGISTER_STATIC(curerr);
1026 MZ_REGISTER_STATIC(exn_catching_apply);
1027 MZ_REGISTER_STATIC(exn_p);
1028 MZ_REGISTER_STATIC(exn_message);
1029 MZ_REGISTER_STATIC(vim_exn);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001030
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001031 MZ_GC_CHECK();
1032
1033#ifdef INCLUDE_MZSCHEME_BASE
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001034 // invoke function from generated and included mzscheme_base.c
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001035 declare_modules(environment);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001036#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001037
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001038 // setup 'current-library-collection-paths' parameter
Bram Moolenaare2a49d82007-07-06 17:43:08 +00001039# if MZSCHEME_VERSION_MAJOR >= 299
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001040 {
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001041 Scheme_Object *coll_path = NULL;
1042 int mustfree = FALSE;
1043 char_u *s;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001044
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001045 MZ_GC_DECL_REG(1);
1046 MZ_GC_VAR_IN_REG(0, coll_path);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001047 MZ_GC_REG();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001048 // workaround for dynamic loading on windows
Bram Moolenaar74a97b12016-02-18 21:19:21 +01001049 s = vim_getenv((char_u *)"PLTCOLLECTS", &mustfree);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001050 if (s != NULL)
1051 {
Bram Moolenaar74a97b12016-02-18 21:19:21 +01001052 coll_path = scheme_make_path((char *)s);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001053 MZ_GC_CHECK();
1054 if (mustfree)
1055 vim_free(s);
1056 }
1057# ifdef MZSCHEME_COLLECTS
1058 if (coll_path == NULL)
1059 {
1060 coll_path = scheme_make_path(MZSCHEME_COLLECTS);
1061 MZ_GC_CHECK();
1062 }
Bram Moolenaar39d7d512013-01-31 21:09:15 +01001063# endif
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001064 if (coll_path != NULL)
1065 {
1066 scheme_set_collects_path(coll_path);
1067 MZ_GC_CHECK();
1068 }
1069 MZ_GC_UNREG();
1070 }
Bram Moolenaare2a49d82007-07-06 17:43:08 +00001071# else
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001072# ifdef MZSCHEME_COLLECTS
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001073 {
1074 Scheme_Object *coll_string = NULL;
1075 Scheme_Object *coll_pair = NULL;
1076 Scheme_Config *config = NULL;
1077
1078 MZ_GC_DECL_REG(3);
1079 MZ_GC_VAR_IN_REG(0, coll_string);
1080 MZ_GC_VAR_IN_REG(1, coll_pair);
1081 MZ_GC_VAR_IN_REG(2, config);
1082 MZ_GC_REG();
Bram Moolenaar75676462013-01-30 14:55:42 +01001083 coll_string = scheme_make_byte_string(MZSCHEME_COLLECTS);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001084 MZ_GC_CHECK();
1085 coll_pair = scheme_make_pair(coll_string, scheme_null);
1086 MZ_GC_CHECK();
Bram Moolenaar75676462013-01-30 14:55:42 +01001087 config = scheme_current_config();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001088 MZ_GC_CHECK();
1089 scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair);
1090 MZ_GC_CHECK();
1091 MZ_GC_UNREG();
1092 }
Bram Moolenaare2a49d82007-07-06 17:43:08 +00001093# endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001094#endif
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001095
1096# if MZSCHEME_VERSION_MAJOR >= 600
1097 {
1098 Scheme_Object *config_path = NULL;
1099 int mustfree = FALSE;
1100 char_u *s;
1101
1102 MZ_GC_DECL_REG(1);
1103 MZ_GC_VAR_IN_REG(0, config_path);
1104 MZ_GC_REG();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001105 // workaround for dynamic loading on windows
Bram Moolenaar5b7d1772016-06-13 19:54:22 +02001106 s = vim_getenv((char_u *)"PLTCONFIGDIR", &mustfree);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001107 if (s != NULL)
1108 {
Bram Moolenaar5b7d1772016-06-13 19:54:22 +02001109 config_path = scheme_make_path((char *)s);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001110 MZ_GC_CHECK();
1111 if (mustfree)
1112 vim_free(s);
1113 }
1114#ifdef MZSCHEME_CONFIGDIR
1115 if (config_path == NULL)
1116 {
1117 config_path = scheme_make_path(MZSCHEME_CONFIGDIR);
1118 MZ_GC_CHECK();
1119 }
1120#endif
1121 if (config_path != NULL)
1122 {
1123 scheme_set_config_path(config_path);
1124 MZ_GC_CHECK();
1125 }
1126 MZ_GC_UNREG();
1127 }
1128# endif
1129
1130#if MZSCHEME_VERSION_MAJOR >= 400
1131 scheme_init_collection_paths(environment, scheme_null);
1132#endif
1133
1134 /*
1135 * versions 4.x do not provide Scheme bindings by default
1136 * we need to add them explicitly
1137 */
1138 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001139 // use error handler to avoid abort
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001140 scheme_dynamic_wind(NULL, load_base_module, NULL,
1141 load_base_module_on_error, "racket/base");
1142 if (load_base_module_failed)
1143 {
1144 load_base_module_failed = FALSE;
1145 scheme_dynamic_wind(NULL, load_base_module, NULL,
1146 load_base_module_on_error, "scheme/base");
1147 if (load_base_module_failed)
1148 return -1;
1149 }
1150 }
1151
1152 register_vim_exn();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001153 // use new environment to initialise exception handling
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001154 init_exn_catching_apply();
1155
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001156 // redirect output
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001157 scheme_console_output = do_output;
1158 scheme_console_printf = do_printf;
1159
Bram Moolenaar555b2802005-05-19 21:08:39 +00001160#ifdef HAVE_SANDBOX
Bram Moolenaar555b2802005-05-19 21:08:39 +00001161 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001162 Scheme_Object *make_security_guard = NULL;
1163 MZ_GC_DECL_REG(1);
1164 MZ_GC_VAR_IN_REG(0, make_security_guard);
1165 MZ_GC_REG();
1166
1167#if MZSCHEME_VERSION_MAJOR < 400
1168 {
1169 Scheme_Object *make_security_guard_symbol = NULL;
1170 MZ_GC_DECL_REG(1);
1171 MZ_GC_VAR_IN_REG(0, make_security_guard_symbol);
1172 MZ_GC_REG();
1173 make_security_guard_symbol = scheme_intern_symbol("make-security-guard");
1174 MZ_GC_CHECK();
1175 make_security_guard = scheme_lookup_global(
1176 make_security_guard_symbol, environment);
1177 MZ_GC_UNREG();
1178 }
1179#else
1180 make_security_guard = scheme_builtin_value("make-security-guard");
1181 MZ_GC_CHECK();
1182#endif
1183
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001184 // setup sandbox guards
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001185 if (make_security_guard != NULL)
1186 {
1187 Scheme_Object *args[3] = {NULL, NULL, NULL};
1188 Scheme_Object *guard = NULL;
1189 Scheme_Config *config = NULL;
1190 MZ_GC_DECL_REG(5);
1191 MZ_GC_ARRAY_VAR_IN_REG(0, args, 3);
1192 MZ_GC_VAR_IN_REG(3, guard);
1193 MZ_GC_VAR_IN_REG(4, config);
1194 MZ_GC_REG();
Bram Moolenaar75676462013-01-30 14:55:42 +01001195 config = scheme_current_config();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001196 MZ_GC_CHECK();
1197 args[0] = scheme_get_param(config, MZCONFIG_SECURITY_GUARD);
1198 MZ_GC_CHECK();
1199 args[1] = scheme_make_prim_w_arity(sandbox_file_guard,
1200 "sandbox-file-guard", 3, 3);
1201 args[2] = scheme_make_prim_w_arity(sandbox_network_guard,
1202 "sandbox-network-guard", 4, 4);
1203 guard = scheme_apply(make_security_guard, 3, args);
1204 MZ_GC_CHECK();
1205 scheme_set_param(config, MZCONFIG_SECURITY_GUARD, guard);
1206 MZ_GC_CHECK();
1207 MZ_GC_UNREG();
1208 }
1209 MZ_GC_UNREG();
Bram Moolenaar555b2802005-05-19 21:08:39 +00001210 }
1211#endif
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001212 // Create buffer and window types for use in Scheme code
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001213 mz_buffer_type = scheme_make_type("<vim-buffer>");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001214 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001215 mz_window_type = scheme_make_type("<vim-window>");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001216 MZ_GC_CHECK();
1217#ifdef MZ_PRECISE_GC
1218 GC_register_traversers(mz_buffer_type,
1219 buffer_size_proc, buffer_mark_proc, buffer_fixup_proc,
1220 TRUE, TRUE);
1221 GC_register_traversers(mz_window_type,
1222 window_size_proc, window_mark_proc, window_fixup_proc,
1223 TRUE, TRUE);
1224#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001225
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001226 make_modules();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001227
1228 /*
1229 * setup callback to receive notifications
1230 * whether thread scheduling is (or not) required
1231 */
1232 scheme_notify_multithread = notify_multithread;
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001233
1234 return 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001235}
1236
1237/*
1238 * This routine is called for each new invocation of MzScheme
1239 * to make sure things are properly initialized.
1240 */
1241 static int
1242mzscheme_init(void)
1243{
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001244 if (!initialized)
1245 {
Bram Moolenaar33570922005-01-25 22:26:29 +00001246#ifdef DYNAMIC_MZSCHEME
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001247 if (disabled || !mzscheme_enabled(TRUE))
Bram Moolenaar33570922005-01-25 22:26:29 +00001248 {
Bram Moolenaar9d00e4a2022-01-05 17:49:15 +00001249 emsg(_(e_sorry_this_command_is_disabled_the_mzscheme_libraries_could_not_be_loaded));
Bram Moolenaar33570922005-01-25 22:26:29 +00001250 return -1;
1251 }
1252#endif
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001253 if (load_base_module_failed || startup_mzscheme())
1254 {
Bram Moolenaard82a47d2022-01-05 20:24:39 +00001255 emsg(_(e_sorry_this_command_is_disabled_the_mzscheme_racket_base_module_could_not_be_loaded));
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001256 return -1;
1257 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001258 initialized = TRUE;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001259 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001260 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001261 Scheme_Config *config = NULL;
1262 MZ_GC_DECL_REG(1);
1263 MZ_GC_VAR_IN_REG(0, config);
1264 MZ_GC_REG();
Bram Moolenaar75676462013-01-30 14:55:42 +01001265 config = scheme_current_config();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001266 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001267 // recreate ports each call effectively clearing these ones
Bram Moolenaar75676462013-01-30 14:55:42 +01001268 curout = scheme_make_byte_string_output_port();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001269 MZ_GC_CHECK();
Bram Moolenaar75676462013-01-30 14:55:42 +01001270 curerr = scheme_make_byte_string_output_port();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001271 MZ_GC_CHECK();
1272 scheme_set_param(config, MZCONFIG_OUTPUT_PORT, curout);
1273 MZ_GC_CHECK();
1274 scheme_set_param(config, MZCONFIG_ERROR_PORT, curerr);
1275 MZ_GC_CHECK();
1276 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001277 }
1278
1279 return 0;
1280}
1281
1282/*
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001283 *========================================================================
1284 * 2. External Interface
1285 *========================================================================
1286 */
1287
1288/*
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001289 * Evaluate command with exception handling
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001290 */
1291 static int
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001292eval_with_exn_handling(void *data, Scheme_Closed_Prim *what, Scheme_Object **ret)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001293{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001294 Scheme_Object *value = NULL;
1295 Scheme_Object *exn = NULL;
1296 Scheme_Object *prim = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001297
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001298 MZ_GC_DECL_REG(3);
1299 MZ_GC_VAR_IN_REG(0, value);
1300 MZ_GC_VAR_IN_REG(1, exn);
1301 MZ_GC_VAR_IN_REG(2, prim);
1302 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001303
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001304 prim = scheme_make_closed_prim_w_arity(what, data, "mzvim", 0, 0);
1305 MZ_GC_CHECK();
1306 value = _apply_thunk_catch_exceptions(prim, &exn);
1307 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001308
1309 if (!value)
1310 {
1311 value = extract_exn_message(exn);
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001312 // Got an exn?
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001313 if (value)
1314 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001315 scheme_display(value, curerr); // Send to stderr-vim
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001316 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001317 do_flush();
1318 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001319 MZ_GC_UNREG();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001320 // `raise' was called on some arbitrary value
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001321 return FAIL;
1322 }
1323
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001324 if (ret != NULL) // if pointer to retval supported give it up
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001325 *ret = value;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001326 // Print any result, as long as it's not a void
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001327 else if (!SCHEME_VOIDP(value))
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001328 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001329 scheme_display(value, curout); // Send to stdout-vim
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001330 MZ_GC_CHECK();
1331 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001332
1333 do_flush();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001334 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001335 return OK;
1336}
1337
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001338/*
1339 * :mzscheme
1340 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001341 static int
1342do_mzscheme_command(exarg_T *eap, void *data, Scheme_Closed_Prim *what)
1343{
1344 if (mzscheme_init())
1345 return FAIL;
1346
1347 range_start = eap->line1;
1348 range_end = eap->line2;
1349
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001350 return eval_with_exn_handling(data, what, NULL);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001351}
1352
1353/*
1354 * Routine called by VIM when deleting a buffer
1355 */
1356 void
1357mzscheme_buffer_free(buf_T *buf)
1358{
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001359 if (buf->b_mzscheme_ref == NULL)
1360 return;
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001361
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001362 vim_mz_buffer *bp = NULL;
1363 MZ_GC_DECL_REG(1);
1364 MZ_GC_VAR_IN_REG(0, bp);
1365 MZ_GC_REG();
1366
1367 bp = BUFFER_REF(buf);
1368 bp->buf = INVALID_BUFFER_VALUE;
Bram Moolenaar75676462013-01-30 14:55:42 +01001369#ifndef MZ_PRECISE_GC
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001370 scheme_gc_ptr_ok(bp);
Bram Moolenaar75676462013-01-30 14:55:42 +01001371#else
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001372 scheme_free_immobile_box(buf->b_mzscheme_ref);
Bram Moolenaar75676462013-01-30 14:55:42 +01001373#endif
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001374 buf->b_mzscheme_ref = NULL;
1375 MZ_GC_CHECK();
1376 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001377}
1378
1379/*
1380 * Routine called by VIM when deleting a Window
1381 */
1382 void
1383mzscheme_window_free(win_T *win)
1384{
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001385 if (win->w_mzscheme_ref == NULL)
1386 return;
1387
1388 vim_mz_window *wp = NULL;
1389 MZ_GC_DECL_REG(1);
1390 MZ_GC_VAR_IN_REG(0, wp);
1391 MZ_GC_REG();
1392 wp = WINDOW_REF(win);
1393 wp->win = INVALID_WINDOW_VALUE;
Bram Moolenaar75676462013-01-30 14:55:42 +01001394#ifndef MZ_PRECISE_GC
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001395 scheme_gc_ptr_ok(wp);
Bram Moolenaar75676462013-01-30 14:55:42 +01001396#else
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001397 scheme_free_immobile_box(win->w_mzscheme_ref);
Bram Moolenaar75676462013-01-30 14:55:42 +01001398#endif
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001399 win->w_mzscheme_ref = NULL;
1400 MZ_GC_CHECK();
1401 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001402}
1403
1404/*
1405 * ":mzscheme" (or ":mz")
1406 */
1407 void
1408ex_mzscheme(exarg_T *eap)
1409{
1410 char_u *script;
1411
1412 script = script_get(eap, eap->arg);
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001413 if (eap->skip)
1414 return;
1415
1416 if (script == NULL)
1417 do_mzscheme_command(eap, eap->arg, do_eval);
1418 else
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001419 {
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001420 do_mzscheme_command(eap, script, do_eval);
1421 vim_free(script);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001422 }
1423}
1424
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001425 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001426do_load(void *data, int noargc UNUSED, Scheme_Object **noargv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001427{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001428 Scheme_Object *expr = NULL;
1429 Scheme_Object *result = NULL;
1430 char *file = NULL;
1431 Port_Info *pinfo = (Port_Info *)data;
1432
1433 MZ_GC_DECL_REG(3);
1434 MZ_GC_VAR_IN_REG(0, expr);
1435 MZ_GC_VAR_IN_REG(1, result);
1436 MZ_GC_VAR_IN_REG(2, file);
1437 MZ_GC_REG();
1438
1439 file = (char *)scheme_malloc_fail_ok(scheme_malloc_atomic, MAXPATHL + 1);
1440 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001441
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001442 // make Vim expansion
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001443 expand_env((char_u *)pinfo->name, (char_u *)file, MAXPATHL);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001444 pinfo->port = scheme_open_input_file(file, "mzfile");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001445 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001446 scheme_count_lines(pinfo->port); // to get accurate read error location
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001447 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001448
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001449 // Like REPL but print only last result
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001450 while (!SCHEME_EOFP(expr = scheme_read(pinfo->port)))
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001451 {
1452 result = scheme_eval(expr, environment);
1453 MZ_GC_CHECK();
1454 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001455
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001456 // errors will be caught in do_mzscheme_command and ex_mzfile
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001457 scheme_close_input_port(pinfo->port);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001458 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001459 pinfo->port = NULL;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001460 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001461 return result;
1462}
1463
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001464/*
1465 * :mzfile
1466 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001467 void
1468ex_mzfile(exarg_T *eap)
1469{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001470 Port_Info pinfo = {NULL, NULL};
1471
1472 MZ_GC_DECL_REG(1);
1473 MZ_GC_VAR_IN_REG(0, pinfo.port);
1474 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001475
1476 pinfo.name = (char *)eap->arg;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001477 if (do_mzscheme_command(eap, &pinfo, do_load) != OK
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001478 && pinfo.port != NULL) // looks like port was not closed
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001479 {
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001480 scheme_close_input_port(pinfo.port);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001481 MZ_GC_CHECK();
1482 }
1483 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001484}
1485
1486
1487/*
1488 *========================================================================
1489 * Exception handling code -- cribbed form the MzScheme sources and
1490 * Matthew Flatt's "Inside PLT MzScheme" document.
1491 *========================================================================
1492 */
1493 static void
1494init_exn_catching_apply(void)
1495{
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001496 if (exn_catching_apply)
1497 return;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001498
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001499 char *e =
1500 "(lambda (thunk) "
1501 "(with-handlers ([void (lambda (exn) (cons #f exn))]) "
1502 "(cons #t (thunk))))";
1503
1504 exn_catching_apply = scheme_eval_string(e, environment);
1505 MZ_GC_CHECK();
1506 exn_p = scheme_builtin_value("exn?");
1507 MZ_GC_CHECK();
1508 exn_message = scheme_builtin_value("exn-message");
1509 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001510}
1511
1512/*
1513 * This function applies a thunk, returning the Scheme value if there's
1514 * no exception, otherwise returning NULL and setting *exn to the raised
1515 * value (usually an exn structure).
1516 */
1517 static Scheme_Object *
1518_apply_thunk_catch_exceptions(Scheme_Object *f, Scheme_Object **exn)
1519{
1520 Scheme_Object *v;
1521
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001522 v = _scheme_apply(exn_catching_apply, 1, &f);
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001523 // v is a pair: (cons #t value) or (cons #f exn)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001524
1525 if (SCHEME_TRUEP(SCHEME_CAR(v)))
1526 return SCHEME_CDR(v);
1527 else
1528 {
1529 *exn = SCHEME_CDR(v);
1530 return NULL;
1531 }
1532}
1533
1534 static Scheme_Object *
1535extract_exn_message(Scheme_Object *v)
1536{
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001537 if (SCHEME_TRUEP(_scheme_apply(exn_p, 1, &v)))
1538 return _scheme_apply(exn_message, 1, &v);
1539 else
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001540 return NULL; // Not an exn structure
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001541}
1542
1543 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001544do_eval(void *s, int noargc UNUSED, Scheme_Object **noargv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001545{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001546 return scheme_eval_string_all((char *)s, environment, TRUE);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001547}
1548
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001549/*
1550 *========================================================================
1551 * 3. MzScheme I/O Handlers
1552 *========================================================================
1553 */
1554 static void
Bram Moolenaar64404472010-06-26 06:24:45 +02001555do_intrnl_output(char *mesg, int error)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001556{
1557 char *p, *prev;
1558
1559 prev = mesg;
1560 p = strchr(prev, '\n');
1561 while (p)
1562 {
1563 *p = '\0';
1564 if (error)
Bram Moolenaarf9e3e092019-01-13 23:38:42 +01001565 emsg(prev);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001566 else
Bram Moolenaar32526b32019-01-19 17:43:09 +01001567 msg(prev);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001568 prev = p + 1;
1569 p = strchr(prev, '\n');
1570 }
1571
1572 if (error)
Bram Moolenaarf9e3e092019-01-13 23:38:42 +01001573 emsg(prev);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001574 else
Bram Moolenaar32526b32019-01-19 17:43:09 +01001575 msg(prev);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001576}
1577
1578 static void
Bram Moolenaar75676462013-01-30 14:55:42 +01001579do_output(char *mesg, OUTPUT_LEN_TYPE len UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001580{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001581 // TODO: use len, the string may not be NUL terminated
Bram Moolenaar64404472010-06-26 06:24:45 +02001582 do_intrnl_output(mesg, 0);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001583}
1584
1585 static void
Bram Moolenaar64404472010-06-26 06:24:45 +02001586do_err_output(char *mesg)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001587{
Bram Moolenaar64404472010-06-26 06:24:45 +02001588 do_intrnl_output(mesg, 1);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001589}
1590
1591 static void
1592do_printf(char *format, ...)
1593{
Bram Moolenaar64404472010-06-26 06:24:45 +02001594 do_intrnl_output(format, 1);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001595}
1596
1597 static void
1598do_flush(void)
1599{
1600 char *buff;
Bram Moolenaar75676462013-01-30 14:55:42 +01001601 OUTPUT_LEN_TYPE length;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001602
Bram Moolenaar75676462013-01-30 14:55:42 +01001603 buff = scheme_get_sized_byte_string_output(curerr, &length);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001604 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001605 if (length)
1606 {
Bram Moolenaar64404472010-06-26 06:24:45 +02001607 do_err_output(buff);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001608 return;
1609 }
1610
Bram Moolenaar75676462013-01-30 14:55:42 +01001611 buff = scheme_get_sized_byte_string_output(curout, &length);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001612 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001613 if (length)
1614 do_output(buff, length);
1615}
1616
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001617/*
1618 *========================================================================
1619 * 4. Implementation of the Vim Features for MzScheme
1620 *========================================================================
1621 */
1622
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001623/*
1624 * (command {command-string})
1625 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001626 static Scheme_Object *
1627vim_command(void *data, int argc, Scheme_Object **argv)
1628{
1629 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar75676462013-01-30 14:55:42 +01001630 Scheme_Object *cmd = NULL;
1631 MZ_GC_DECL_REG(1);
1632 MZ_GC_VAR_IN_REG(0, cmd);
1633 MZ_GC_REG();
1634 cmd = GUARANTEED_STRING_ARG(prim->name, 0);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001635
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001636 // may be use do_cmdline_cmd?
Bram Moolenaar75676462013-01-30 14:55:42 +01001637 do_cmdline(BYTE_STRING_VALUE(cmd), NULL, NULL, DOCMD_NOWAIT|DOCMD_VERBOSE);
Bram Moolenaara4d158b2022-08-14 14:17:45 +01001638 update_screen(UPD_VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001639
Bram Moolenaar75676462013-01-30 14:55:42 +01001640 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001641 raise_if_error();
1642 return scheme_void;
1643}
1644
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001645/*
1646 * (eval {expr-string})
1647 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001648 static Scheme_Object *
Bram Moolenaard2142212013-01-30 17:41:50 +01001649vim_eval(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001650{
1651#ifdef FEAT_EVAL
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001652 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar75676462013-01-30 14:55:42 +01001653 Scheme_Object *result = NULL;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001654 typval_T *vim_result;
Bram Moolenaar75676462013-01-30 14:55:42 +01001655 Scheme_Object *expr = NULL;
1656 MZ_GC_DECL_REG(2);
1657 MZ_GC_VAR_IN_REG(0, result);
1658 MZ_GC_VAR_IN_REG(1, expr);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001659 MZ_GC_REG();
Bram Moolenaar75676462013-01-30 14:55:42 +01001660 expr = GUARANTEED_STRING_ARG(prim->name, 0);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001661
Bram Moolenaar75676462013-01-30 14:55:42 +01001662 vim_result = eval_expr(BYTE_STRING_VALUE(expr), NULL);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001663
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001664 if (vim_result == NULL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001665 raise_vim_exn(_("invalid expression"));
1666
Bram Moolenaar75676462013-01-30 14:55:42 +01001667 result = vim_to_mzscheme(vim_result);
1668 MZ_GC_CHECK();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001669 free_tv(vim_result);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001670
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001671 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001672 return result;
1673#else
1674 raise_vim_exn(_("expressions disabled at compile time"));
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001675 // unreachable
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001676 return scheme_false;
1677#endif
1678}
1679
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001680/*
1681 * (range-start)
1682 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001683 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001684get_range_start(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001685{
1686 return scheme_make_integer(range_start);
1687}
1688
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001689/*
1690 * (range-end)
1691 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001692 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001693get_range_end(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001694{
1695 return scheme_make_integer(range_end);
1696}
1697
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001698/*
1699 * (beep)
1700 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001701 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001702mzscheme_beep(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001703{
Bram Moolenaar165bc692015-07-21 17:53:25 +02001704 vim_beep(BO_LANG);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001705 return scheme_void;
1706}
1707
1708static Scheme_Object *M_global = NULL;
1709
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001710/*
1711 * (get-option {option-name}) [buffer/window]
1712 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001713 static Scheme_Object *
1714get_option(void *data, int argc, Scheme_Object **argv)
1715{
1716 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001717 long value;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001718 char *strval;
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001719 getoption_T rc;
Bram Moolenaar75676462013-01-30 14:55:42 +01001720 Scheme_Object *rval = NULL;
1721 Scheme_Object *name = NULL;
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001722 int scope = 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001723 buf_T *save_curb = curbuf;
1724 win_T *save_curw = curwin;
1725
Bram Moolenaar75676462013-01-30 14:55:42 +01001726 MZ_GC_DECL_REG(2);
1727 MZ_GC_VAR_IN_REG(0, rval);
1728 MZ_GC_VAR_IN_REG(1, name);
1729 MZ_GC_REG();
1730
1731 name = GUARANTEED_STRING_ARG(prim->name, 0);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001732
1733 if (argc > 1)
1734 {
1735 if (M_global == NULL)
1736 {
1737 MZ_REGISTER_STATIC(M_global);
1738 M_global = scheme_intern_symbol("global");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001739 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001740 }
1741
1742 if (argv[1] == M_global)
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001743 scope = OPT_GLOBAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001744 else if (SCHEME_VIMBUFFERP(argv[1]))
1745 {
1746 curbuf = get_valid_buffer(argv[1]);
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001747 scope = OPT_LOCAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001748 }
1749 else if (SCHEME_VIMWINDOWP(argv[1]))
1750 {
1751 win_T *win = get_valid_window(argv[1]);
1752
1753 curwin = win;
1754 curbuf = win->w_buffer;
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001755 scope = OPT_LOCAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001756 }
1757 else
1758 scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv);
1759 }
1760
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001761 rc = get_option_value(BYTE_STRING_VALUE(name), &value, (char_u **)&strval,
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001762 NULL, scope);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001763 curbuf = save_curb;
1764 curwin = save_curw;
1765
1766 switch (rc)
1767 {
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001768 case gov_bool:
1769 case gov_number:
Bram Moolenaar75676462013-01-30 14:55:42 +01001770 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001771 return scheme_make_integer_value(value);
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001772 case gov_string:
Bram Moolenaar75676462013-01-30 14:55:42 +01001773 rval = scheme_make_byte_string(strval);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001774 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001775 vim_free(strval);
Bram Moolenaar75676462013-01-30 14:55:42 +01001776 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001777 return rval;
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001778 case gov_hidden_bool:
1779 case gov_hidden_number:
1780 case gov_hidden_string:
Bram Moolenaar75676462013-01-30 14:55:42 +01001781 MZ_GC_UNREG();
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001782 raise_vim_exn(_("hidden option"));
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001783 //NOTREACHED
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001784 case gov_unknown:
Bram Moolenaar75676462013-01-30 14:55:42 +01001785 MZ_GC_UNREG();
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001786 raise_vim_exn(_("unknown option"));
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001787 //NOTREACHED
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001788 }
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001789 // unreachable
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001790 return scheme_void;
1791}
1792
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001793/*
1794 * (set-option {option-changing-string} [buffer/window])
1795 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001796 static Scheme_Object *
1797set_option(void *data, int argc, Scheme_Object **argv)
1798{
Bram Moolenaar75676462013-01-30 14:55:42 +01001799 char_u *command = NULL;
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001800 int scope = 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001801 buf_T *save_curb = curbuf;
1802 win_T *save_curw = curwin;
1803 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar75676462013-01-30 14:55:42 +01001804 Scheme_Object *cmd = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001805
Bram Moolenaar75676462013-01-30 14:55:42 +01001806 MZ_GC_DECL_REG(1);
1807 MZ_GC_VAR_IN_REG(0, cmd);
1808 MZ_GC_REG();
1809 cmd = GUARANTEED_STRING_ARG(prim->name, 0);
1810
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001811 if (argc > 1)
1812 {
1813 if (M_global == NULL)
1814 {
1815 MZ_REGISTER_STATIC(M_global);
1816 M_global = scheme_intern_symbol("global");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001817 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001818 }
1819
1820 if (argv[1] == M_global)
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001821 scope = OPT_GLOBAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001822 else if (SCHEME_VIMBUFFERP(argv[1]))
1823 {
1824 curbuf = get_valid_buffer(argv[1]);
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001825 scope = OPT_LOCAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001826 }
1827 else if (SCHEME_VIMWINDOWP(argv[1]))
1828 {
1829 win_T *win = get_valid_window(argv[1]);
1830 curwin = win;
1831 curbuf = win->w_buffer;
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001832 scope = OPT_LOCAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001833 }
1834 else
1835 scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv);
1836 }
1837
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001838 // do_set can modify cmd, make copy
Bram Moolenaar75676462013-01-30 14:55:42 +01001839 command = vim_strsave(BYTE_STRING_VALUE(cmd));
1840 MZ_GC_UNREG();
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001841 do_set(command, scope);
Bram Moolenaar75676462013-01-30 14:55:42 +01001842 vim_free(command);
Bram Moolenaara4d158b2022-08-14 14:17:45 +01001843 update_screen(UPD_NOT_VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001844 curbuf = save_curb;
1845 curwin = save_curw;
1846 raise_if_error();
1847 return scheme_void;
1848}
1849
1850/*
1851 *===========================================================================
1852 * 5. Vim Window-related Manipulation Functions
1853 *===========================================================================
1854 */
1855
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001856/*
1857 * (curr-win)
1858 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001859 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001860get_curr_win(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001861{
1862 return (Scheme_Object *)get_vim_curr_window();
1863}
1864
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001865/*
1866 * (win-count)
1867 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001868 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001869get_window_count(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001870{
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001871 int n = 0;
Bram Moolenaard2142212013-01-30 17:41:50 +01001872 win_T *w;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001873
Bram Moolenaar29323592016-07-24 22:04:11 +02001874 FOR_ALL_WINDOWS(w)
Bram Moolenaarf740b292006-02-16 22:11:02 +00001875 ++n;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001876 return scheme_make_integer(n);
1877}
1878
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001879/*
1880 * (get-win-list [buffer])
1881 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001882 static Scheme_Object *
1883get_window_list(void *data, int argc, Scheme_Object **argv)
1884{
1885 Vim_Prim *prim = (Vim_Prim *)data;
1886 vim_mz_buffer *buf;
1887 Scheme_Object *list;
Bram Moolenaard2142212013-01-30 17:41:50 +01001888 win_T *w = firstwin;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001889
1890 buf = get_buffer_arg(prim->name, 0, argc, argv);
1891 list = scheme_null;
1892
Bram Moolenaard2142212013-01-30 17:41:50 +01001893 for ( ; w != NULL; w = w->w_next)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001894 if (w->w_buffer == buf->buf)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001895 {
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001896 list = scheme_make_pair(window_new(w), list);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001897 MZ_GC_CHECK();
1898 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001899
1900 return list;
1901}
1902
1903 static Scheme_Object *
1904window_new(win_T *win)
1905{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001906 vim_mz_window *self = NULL;
1907
1908 MZ_GC_DECL_REG(1);
1909 MZ_GC_VAR_IN_REG(0, self);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001910
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001911 // We need to handle deletion of windows underneath us.
1912 // If we add a "w_mzscheme_ref" field to the win_T structure,
1913 // then we can get at it in win_free() in vim.
1914 //
1915 // On a win_free() we set the Scheme object's win_T *field
1916 // to an invalid value. We trap all uses of a window
1917 // object, and reject them if the win_T *field is invalid.
Bram Moolenaare344bea2005-09-01 20:46:49 +00001918 if (win->w_mzscheme_ref != NULL)
Bram Moolenaar75676462013-01-30 14:55:42 +01001919 return (Scheme_Object *)WINDOW_REF(win);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001920
Bram Moolenaar75676462013-01-30 14:55:42 +01001921 MZ_GC_REG();
1922 self = scheme_malloc_fail_ok(scheme_malloc_tagged, sizeof(vim_mz_window));
Bram Moolenaara80faa82020-04-12 19:37:17 +02001923 CLEAR_POINTER(self);
Bram Moolenaar75676462013-01-30 14:55:42 +01001924#ifndef MZ_PRECISE_GC
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001925 scheme_dont_gc_ptr(self); // because win isn't visible to GC
Bram Moolenaar75676462013-01-30 14:55:42 +01001926#else
1927 win->w_mzscheme_ref = scheme_malloc_immobile_box(NULL);
1928#endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001929 MZ_GC_CHECK();
Bram Moolenaar75676462013-01-30 14:55:42 +01001930 WINDOW_REF(win) = self;
1931 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001932 self->win = win;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001933 self->so.type = mz_window_type;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001934
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001935 MZ_GC_UNREG();
Bram Moolenaar75676462013-01-30 14:55:42 +01001936 return (Scheme_Object *)self;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001937}
1938
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001939/*
1940 * (get-win-num [window])
1941 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001942 static Scheme_Object *
Bram Moolenaard2142212013-01-30 17:41:50 +01001943get_window_num(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001944{
Bram Moolenaard2142212013-01-30 17:41:50 +01001945 int nr = 1;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001946 Vim_Prim *prim = (Vim_Prim *)data;
1947 win_T *win = get_window_arg(prim->name, 0, argc, argv)->win;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001948 win_T *wp;
1949
1950 for (wp = firstwin; wp != win; wp = wp->w_next)
1951 ++nr;
1952
1953 return scheme_make_integer(nr);
1954}
1955
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001956/*
1957 * (get-win-by-num {windownum})
1958 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001959 static Scheme_Object *
1960get_window_by_num(void *data, int argc, Scheme_Object **argv)
1961{
1962 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaard2142212013-01-30 17:41:50 +01001963 win_T *win = firstwin;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001964 int fnum;
1965
1966 fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1967 if (fnum < 1)
1968 scheme_signal_error(_("window index is out of range"));
1969
Bram Moolenaard2142212013-01-30 17:41:50 +01001970 for ( ; win != NULL; win = win->w_next, --fnum)
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001971 if (fnum == 1) // to be 1-based
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001972 return window_new(win);
1973
1974 return scheme_false;
1975}
1976
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001977/*
1978 * (get-win-buffer [window])
1979 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001980 static Scheme_Object *
1981get_window_buffer(void *data, int argc, Scheme_Object **argv)
1982{
1983 Vim_Prim *prim = (Vim_Prim *)data;
1984 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
1985
1986 return buffer_new(win->win->w_buffer);
1987}
1988
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001989/*
1990 * (get-win-height [window])
1991 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001992 static Scheme_Object *
1993get_window_height(void *data, int argc, Scheme_Object **argv)
1994{
1995 Vim_Prim *prim = (Vim_Prim *)data;
1996 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
1997
1998 return scheme_make_integer(win->win->w_height);
1999}
2000
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002001/*
2002 * (set-win-height {height} [window])
2003 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002004 static Scheme_Object *
2005set_window_height(void *data, int argc, Scheme_Object **argv)
2006{
2007 Vim_Prim *prim = (Vim_Prim *)data;
2008 vim_mz_window *win;
2009 win_T *savewin;
2010 int height;
2011
2012 win = get_window_arg(prim->name, 1, argc, argv);
2013 height = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2014
2015#ifdef FEAT_GUI
2016 need_mouse_correct = TRUE;
2017#endif
2018
2019 savewin = curwin;
2020 curwin = win->win;
2021 win_setheight(height);
2022 curwin = savewin;
2023
2024 raise_if_error();
2025 return scheme_void;
2026}
2027
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002028/*
2029 * (get-win-width [window])
2030 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002031 static Scheme_Object *
2032get_window_width(void *data, int argc, Scheme_Object **argv)
2033{
2034 Vim_Prim *prim = (Vim_Prim *)data;
2035 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
2036
Bram Moolenaar02631462017-09-22 15:20:32 +02002037 return scheme_make_integer(win->win->w_width);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002038}
2039
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002040/*
2041 * (set-win-width {width} [window])
2042 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002043 static Scheme_Object *
2044set_window_width(void *data, int argc, Scheme_Object **argv)
2045{
2046 Vim_Prim *prim = (Vim_Prim *)data;
2047 vim_mz_window *win;
2048 win_T *savewin;
2049 int width = 0;
2050
2051 win = get_window_arg(prim->name, 1, argc, argv);
2052 width = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2053
2054# ifdef FEAT_GUI
2055 need_mouse_correct = TRUE;
2056# endif
2057
2058 savewin = curwin;
2059 curwin = win->win;
2060 win_setwidth(width);
2061 curwin = savewin;
2062
2063 raise_if_error();
2064 return scheme_void;
2065}
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002066
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002067/*
2068 * (get-cursor [window]) -> (line . col)
2069 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002070 static Scheme_Object *
2071get_cursor(void *data, int argc, Scheme_Object **argv)
2072{
2073 Vim_Prim *prim = (Vim_Prim *)data;
2074 vim_mz_window *win;
2075 pos_T pos;
2076
2077 win = get_window_arg(prim->name, 0, argc, argv);
2078 pos = win->win->w_cursor;
2079 return scheme_make_pair(scheme_make_integer_value((long)pos.lnum),
2080 scheme_make_integer_value((long)pos.col + 1));
2081}
2082
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002083/*
2084 * (set-cursor (line . col) [window])
2085 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002086 static Scheme_Object *
2087set_cursor(void *data, int argc, Scheme_Object **argv)
2088{
2089 Vim_Prim *prim = (Vim_Prim *)data;
2090 vim_mz_window *win;
2091 long lnum = 0;
2092 long col = 0;
2093
Bram Moolenaar555b2802005-05-19 21:08:39 +00002094#ifdef HAVE_SANDBOX
2095 sandbox_check();
2096#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002097 win = get_window_arg(prim->name, 1, argc, argv);
2098 GUARANTEE_PAIR(prim->name, 0);
2099
2100 if (!SCHEME_INTP(SCHEME_CAR(argv[0]))
2101 || !SCHEME_INTP(SCHEME_CDR(argv[0])))
2102 scheme_wrong_type(prim->name, "integer pair", 0, argc, argv);
2103
2104 lnum = SCHEME_INT_VAL(SCHEME_CAR(argv[0]));
2105 col = SCHEME_INT_VAL(SCHEME_CDR(argv[0])) - 1;
2106
2107 check_line_range(lnum, win->win->w_buffer);
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002108 // don't know how to catch invalid column value
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002109
2110 win->win->w_cursor.lnum = lnum;
2111 win->win->w_cursor.col = col;
Bram Moolenaar53901442018-07-25 22:02:36 +02002112 win->win->w_set_curswant = TRUE;
Bram Moolenaara4d158b2022-08-14 14:17:45 +01002113 update_screen(UPD_VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002114
2115 raise_if_error();
2116 return scheme_void;
2117}
2118/*
2119 *===========================================================================
2120 * 6. Vim Buffer-related Manipulation Functions
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002121 *===========================================================================
2122 */
2123
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002124/*
2125 * (open-buff {filename})
2126 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002127 static Scheme_Object *
2128mzscheme_open_buffer(void *data, int argc, Scheme_Object **argv)
2129{
2130 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002131 int num = 0;
Bram Moolenaar75676462013-01-30 14:55:42 +01002132 Scheme_Object *onum = NULL;
2133 Scheme_Object *buf = NULL;
2134 Scheme_Object *fname;
2135
2136 MZ_GC_DECL_REG(3);
2137 MZ_GC_VAR_IN_REG(0, onum);
2138 MZ_GC_VAR_IN_REG(1, buf);
2139 MZ_GC_VAR_IN_REG(2, fname);
2140 MZ_GC_REG();
2141 fname = GUARANTEED_STRING_ARG(prim->name, 0);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002142
Bram Moolenaar555b2802005-05-19 21:08:39 +00002143#ifdef HAVE_SANDBOX
2144 sandbox_check();
2145#endif
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002146 // TODO make open existing file
Bram Moolenaar75676462013-01-30 14:55:42 +01002147 num = buflist_add(BYTE_STRING_VALUE(fname), BLN_LISTED | BLN_CURBUF);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002148
2149 if (num == 0)
2150 raise_vim_exn(_("couldn't open buffer"));
2151
2152 onum = scheme_make_integer(num);
Bram Moolenaar75676462013-01-30 14:55:42 +01002153 buf = get_buffer_by_num(data, 1, &onum);
2154 MZ_GC_UNREG();
2155 return buf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002156}
2157
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002158/*
2159 * (get-buff-by-num {buffernum})
2160 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002161 static Scheme_Object *
2162get_buffer_by_num(void *data, int argc, Scheme_Object **argv)
2163{
2164 Vim_Prim *prim = (Vim_Prim *)data;
2165 buf_T *buf;
2166 int fnum;
2167
2168 fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2169
Bram Moolenaar29323592016-07-24 22:04:11 +02002170 FOR_ALL_BUFFERS(buf)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002171 if (buf->b_fnum == fnum)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002172 return buffer_new(buf);
2173
2174 return scheme_false;
2175}
2176
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002177/*
2178 * (get-buff-by-name {buffername})
2179 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002180 static Scheme_Object *
2181get_buffer_by_name(void *data, int argc, Scheme_Object **argv)
2182{
2183 Vim_Prim *prim = (Vim_Prim *)data;
2184 buf_T *buf;
Bram Moolenaar75676462013-01-30 14:55:42 +01002185 Scheme_Object *buffer = NULL;
2186 Scheme_Object *fname = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002187
Bram Moolenaar75676462013-01-30 14:55:42 +01002188 MZ_GC_DECL_REG(2);
2189 MZ_GC_VAR_IN_REG(0, buffer);
2190 MZ_GC_VAR_IN_REG(1, fname);
2191 MZ_GC_REG();
2192 fname = GUARANTEED_STRING_ARG(prim->name, 0);
2193 buffer = scheme_false;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002194
Bram Moolenaar29323592016-07-24 22:04:11 +02002195 FOR_ALL_BUFFERS(buf)
Bram Moolenaar75676462013-01-30 14:55:42 +01002196 {
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002197 if (buf->b_ffname == NULL || buf->b_sfname == NULL)
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002198 // empty string
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002199 {
Bram Moolenaar75676462013-01-30 14:55:42 +01002200 if (BYTE_STRING_VALUE(fname)[0] == NUL)
2201 buffer = buffer_new(buf);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002202 }
Bram Moolenaar75676462013-01-30 14:55:42 +01002203 else if (!fnamecmp(buf->b_ffname, BYTE_STRING_VALUE(fname))
2204 || !fnamecmp(buf->b_sfname, BYTE_STRING_VALUE(fname)))
2205 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002206 // either short or long filename matches
Bram Moolenaar75676462013-01-30 14:55:42 +01002207 buffer = buffer_new(buf);
2208 }
2209 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002210
Bram Moolenaar75676462013-01-30 14:55:42 +01002211 MZ_GC_UNREG();
2212 return buffer;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002213}
2214
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002215/*
2216 * (get-next-buff [buffer])
2217 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002218 static Scheme_Object *
2219get_next_buffer(void *data, int argc, Scheme_Object **argv)
2220{
2221 Vim_Prim *prim = (Vim_Prim *)data;
2222 buf_T *buf = get_buffer_arg(prim->name, 0, argc, argv)->buf;
2223
2224 if (buf->b_next == NULL)
2225 return scheme_false;
2226 else
2227 return buffer_new(buf->b_next);
2228}
2229
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002230/*
2231 * (get-prev-buff [buffer])
2232 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002233 static Scheme_Object *
2234get_prev_buffer(void *data, int argc, Scheme_Object **argv)
2235{
2236 Vim_Prim *prim = (Vim_Prim *)data;
2237 buf_T *buf = get_buffer_arg(prim->name, 0, argc, argv)->buf;
2238
2239 if (buf->b_prev == NULL)
2240 return scheme_false;
2241 else
2242 return buffer_new(buf->b_prev);
2243}
2244
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002245/*
2246 * (get-buff-num [buffer])
2247 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002248 static Scheme_Object *
2249get_buffer_num(void *data, int argc, Scheme_Object **argv)
2250{
2251 Vim_Prim *prim = (Vim_Prim *)data;
2252 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
2253
2254 return scheme_make_integer(buf->buf->b_fnum);
2255}
2256
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002257/*
2258 * (buff-count)
2259 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002260 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002261get_buffer_count(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002262{
2263 buf_T *b;
2264 int n = 0;
2265
Bram Moolenaar29323592016-07-24 22:04:11 +02002266 FOR_ALL_BUFFERS(b) ++n;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002267 return scheme_make_integer(n);
2268}
2269
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002270/*
2271 * (get-buff-name [buffer])
2272 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002273 static Scheme_Object *
2274get_buffer_name(void *data, int argc, Scheme_Object **argv)
2275{
2276 Vim_Prim *prim = (Vim_Prim *)data;
2277 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
2278
Bram Moolenaar75676462013-01-30 14:55:42 +01002279 return scheme_make_byte_string((char *)buf->buf->b_ffname);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002280}
2281
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002282/*
2283 * (curr-buff)
2284 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002285 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002286get_curr_buffer(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002287{
2288 return (Scheme_Object *)get_vim_curr_buffer();
2289}
2290
2291 static Scheme_Object *
2292buffer_new(buf_T *buf)
2293{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002294 vim_mz_buffer *self = NULL;
2295
2296 MZ_GC_DECL_REG(1);
2297 MZ_GC_VAR_IN_REG(0, self);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002298
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002299 // We need to handle deletion of buffers underneath us.
2300 // If we add a "b_mzscheme_ref" field to the buf_T structure,
2301 // then we can get at it in buf_freeall() in vim.
Bram Moolenaare344bea2005-09-01 20:46:49 +00002302 if (buf->b_mzscheme_ref)
Bram Moolenaar75676462013-01-30 14:55:42 +01002303 return (Scheme_Object *)BUFFER_REF(buf);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002304
Bram Moolenaar75676462013-01-30 14:55:42 +01002305 MZ_GC_REG();
2306 self = scheme_malloc_fail_ok(scheme_malloc_tagged, sizeof(vim_mz_buffer));
Bram Moolenaara80faa82020-04-12 19:37:17 +02002307 CLEAR_POINTER(self);
Bram Moolenaar75676462013-01-30 14:55:42 +01002308#ifndef MZ_PRECISE_GC
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002309 scheme_dont_gc_ptr(self); // because buf isn't visible to GC
Bram Moolenaar75676462013-01-30 14:55:42 +01002310#else
2311 buf->b_mzscheme_ref = scheme_malloc_immobile_box(NULL);
2312#endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002313 MZ_GC_CHECK();
Bram Moolenaar75676462013-01-30 14:55:42 +01002314 BUFFER_REF(buf) = self;
2315 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002316 self->buf = buf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002317 self->so.type = mz_buffer_type;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002318
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002319 MZ_GC_UNREG();
Bram Moolenaar75676462013-01-30 14:55:42 +01002320 return (Scheme_Object *)self;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002321}
2322
2323/*
2324 * (get-buff-size [buffer])
2325 *
2326 * Get the size (number of lines) in the current buffer.
2327 */
2328 static Scheme_Object *
2329get_buffer_size(void *data, int argc, Scheme_Object **argv)
2330{
2331 Vim_Prim *prim = (Vim_Prim *)data;
2332 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
2333
2334 return scheme_make_integer(buf->buf->b_ml.ml_line_count);
2335}
2336
2337/*
2338 * (get-buff-line {linenr} [buffer])
2339 *
2340 * Get a line from the specified buffer. The line number is
2341 * in Vim format (1-based). The line is returned as a MzScheme
2342 * string object.
2343 */
2344 static Scheme_Object *
2345get_buffer_line(void *data, int argc, Scheme_Object **argv)
2346{
2347 Vim_Prim *prim = (Vim_Prim *)data;
2348 vim_mz_buffer *buf;
2349 int linenr;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002350 char_u *line;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002351
2352 buf = get_buffer_arg(prim->name, 1, argc, argv);
2353 linenr = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2354 line = ml_get_buf(buf->buf, (linenr_T)linenr, FALSE);
2355
2356 raise_if_error();
Bram Moolenaar75676462013-01-30 14:55:42 +01002357 return scheme_make_byte_string((char *)line);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002358}
2359
2360
2361/*
2362 * (get-buff-line-list {start} {end} [buffer])
2363 *
2364 * Get a list of lines from the specified buffer. The line numbers
2365 * are in Vim format (1-based). The range is from lo up to, but not
2366 * including, hi. The list is returned as a list of string objects.
2367 */
2368 static Scheme_Object *
2369get_buffer_line_list(void *data, int argc, Scheme_Object **argv)
2370{
2371 Vim_Prim *prim = (Vim_Prim *)data;
2372 vim_mz_buffer *buf;
2373 int i, hi, lo, n;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002374 Scheme_Object *list = NULL;
2375
2376 MZ_GC_DECL_REG(1);
2377 MZ_GC_VAR_IN_REG(0, list);
2378 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002379
2380 buf = get_buffer_arg(prim->name, 2, argc, argv);
2381 list = scheme_null;
2382 hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1));
2383 lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2384
2385 /*
2386 * Handle some error conditions
2387 */
2388 if (lo < 0)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002389 lo = 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002390
2391 if (hi < 0)
2392 hi = 0;
2393 if (hi < lo)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002394 hi = lo;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002395
2396 n = hi - lo;
2397
2398 for (i = n; i >= 0; --i)
2399 {
Bram Moolenaar75676462013-01-30 14:55:42 +01002400 Scheme_Object *str = scheme_make_byte_string(
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002401 (char *)ml_get_buf(buf->buf, (linenr_T)(lo+i), FALSE));
2402 raise_if_error();
2403
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002404 // Set the list item
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002405 list = scheme_make_pair(str, list);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002406 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002407 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002408 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002409 return list;
2410}
2411
2412/*
2413 * (set-buff-line {linenr} {string/#f} [buffer])
2414 *
2415 * Replace a line in the specified buffer. The line number is
2416 * in Vim format (1-based). The replacement line is given as
2417 * an MzScheme string object. The object is checked for validity
2418 * and correct format. An exception is thrown if the values are not
2419 * the correct format.
2420 *
2421 * It returns a Scheme Object that indicates the length of the
2422 * string changed.
2423 */
2424 static Scheme_Object *
2425set_buffer_line(void *data, int argc, Scheme_Object **argv)
2426{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002427 // First of all, we check the value of the supplied MzScheme object.
2428 // There are three cases:
2429 // 1. #f - this is a deletion.
2430 // 2. A string - this is a replacement.
2431 // 3. Anything else - this is an error.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002432 Vim_Prim *prim = (Vim_Prim *)data;
2433 vim_mz_buffer *buf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002434 Scheme_Object *line = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002435 char *save;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002436 int n;
2437
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002438 MZ_GC_DECL_REG(1);
2439 MZ_GC_VAR_IN_REG(0, line);
2440 MZ_GC_REG();
2441
Bram Moolenaar555b2802005-05-19 21:08:39 +00002442#ifdef HAVE_SANDBOX
2443 sandbox_check();
2444#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002445 n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2446 if (!SCHEME_STRINGP(argv[1]) && !SCHEME_FALSEP(argv[1]))
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002447 scheme_wrong_type(prim->name, "string or #f", 1, argc, argv);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002448 line = argv[1];
2449 buf = get_buffer_arg(prim->name, 2, argc, argv);
2450
2451 check_line_range(n, buf->buf);
2452
2453 if (SCHEME_FALSEP(line))
2454 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002455 buf_T *savebuf = curbuf;
2456
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002457 curbuf = buf->buf;
2458
2459 if (u_savedel((linenr_T)n, 1L) == FAIL)
2460 {
2461 curbuf = savebuf;
2462 raise_vim_exn(_("cannot save undo information"));
2463 }
Bram Moolenaarca70c072020-05-30 20:30:46 +02002464 else if (ml_delete((linenr_T)n) == FAIL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002465 {
2466 curbuf = savebuf;
2467 raise_vim_exn(_("cannot delete line"));
2468 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002469 if (buf->buf == curwin->w_buffer)
2470 mz_fix_cursor(n, n + 1, -1);
Bram Moolenaarcdcaa582009-07-09 18:06:49 +00002471 deleted_lines_mark((linenr_T)n, 1L);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002472
2473 curbuf = savebuf;
2474
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002475 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002476 raise_if_error();
2477 return scheme_void;
2478 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002479 else
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002480 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002481 // Otherwise it's a line
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002482 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002483
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002484 save = string_to_line(line);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002485
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002486 curbuf = buf->buf;
2487
2488 if (u_savesub((linenr_T)n) == FAIL)
2489 {
2490 curbuf = savebuf;
2491 vim_free(save);
2492 raise_vim_exn(_("cannot save undo information"));
2493 }
2494 else if (ml_replace((linenr_T)n, (char_u *)save, TRUE) == FAIL)
2495 {
2496 curbuf = savebuf;
2497 vim_free(save);
2498 raise_vim_exn(_("cannot replace line"));
2499 }
2500 else
2501 {
2502 vim_free(save);
2503 changed_bytes((linenr_T)n, 0);
2504 }
2505
2506 curbuf = savebuf;
2507
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002508 // Check that the cursor is not beyond the end of the line now.
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002509 if (buf->buf == curwin->w_buffer)
2510 check_cursor_col();
2511
2512 MZ_GC_UNREG();
2513 raise_if_error();
2514 return scheme_void;
2515 }
2516}
2517
2518 static void
2519free_array(char **array)
2520{
2521 char **curr = array;
2522 while (*curr != NULL)
2523 vim_free(*curr++);
2524 vim_free(array);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002525}
2526
2527/*
2528 * (set-buff-line-list {start} {end} {string-list/#f/null} [buffer])
2529 *
2530 * Replace a range of lines in the specified buffer. The line numbers are in
2531 * Vim format (1-based). The range is from lo up to, but not including, hi.
2532 * The replacement lines are given as a Scheme list of string objects. The
2533 * list is checked for validity and correct format.
2534 *
2535 * Errors are returned as a value of FAIL. The return value is OK on success.
2536 * If OK is returned and len_change is not NULL, *len_change is set to the
2537 * change in the buffer length.
2538 */
2539 static Scheme_Object *
2540set_buffer_line_list(void *data, int argc, Scheme_Object **argv)
2541{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002542 // First of all, we check the type of the supplied MzScheme object.
2543 // There are three cases:
2544 // 1. #f - this is a deletion.
2545 // 2. A list - this is a replacement.
2546 // 3. Anything else - this is an error.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002547 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002548 vim_mz_buffer *buf = NULL;
2549 Scheme_Object *line_list = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002550 int i, old_len, new_len, hi, lo;
2551 long extra;
2552
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002553 MZ_GC_DECL_REG(1);
2554 MZ_GC_VAR_IN_REG(0, line_list);
2555 MZ_GC_REG();
2556
Bram Moolenaar555b2802005-05-19 21:08:39 +00002557#ifdef HAVE_SANDBOX
2558 sandbox_check();
2559#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002560 lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2561 hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1));
2562 if (!SCHEME_PAIRP(argv[2])
2563 && !SCHEME_FALSEP(argv[2]) && !SCHEME_NULLP(argv[2]))
2564 scheme_wrong_type(prim->name, "list or #f", 2, argc, argv);
2565 line_list = argv[2];
2566 buf = get_buffer_arg(prim->name, 3, argc, argv);
2567 old_len = hi - lo;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002568 if (old_len < 0) // process inverse values wisely
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002569 {
2570 i = lo;
2571 lo = hi;
2572 hi = i;
2573 old_len = -old_len;
2574 }
2575 extra = 0;
2576
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002577 check_line_range(lo, buf->buf); // inclusive
2578 check_line_range(hi - 1, buf->buf); // exclusive
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002579
2580 if (SCHEME_FALSEP(line_list) || SCHEME_NULLP(line_list))
2581 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002582 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002583 curbuf = buf->buf;
2584
2585 if (u_savedel((linenr_T)lo, (long)old_len) == FAIL)
2586 {
2587 curbuf = savebuf;
2588 raise_vim_exn(_("cannot save undo information"));
2589 }
2590 else
2591 {
2592 for (i = 0; i < old_len; i++)
Bram Moolenaarca70c072020-05-30 20:30:46 +02002593 if (ml_delete((linenr_T)lo) == FAIL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002594 {
2595 curbuf = savebuf;
2596 raise_vim_exn(_("cannot delete line"));
2597 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002598 if (buf->buf == curwin->w_buffer)
2599 mz_fix_cursor(lo, hi, -old_len);
Bram Moolenaarcdcaa582009-07-09 18:06:49 +00002600 deleted_lines_mark((linenr_T)lo, (long)old_len);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002601 }
2602
2603 curbuf = savebuf;
2604
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002605 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002606 raise_if_error();
2607 return scheme_void;
2608 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002609 else
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002610 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002611 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002612
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002613 // List
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002614 new_len = scheme_proper_list_length(line_list);
2615 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002616 if (new_len < 0) // improper or cyclic list
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002617 scheme_wrong_type(prim->name, "proper list",
2618 2, argc, argv);
2619 else
2620 {
2621 char **array = NULL;
2622 Scheme_Object *line = NULL;
2623 Scheme_Object *rest = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002624
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002625 MZ_GC_DECL_REG(2);
2626 MZ_GC_VAR_IN_REG(0, line);
2627 MZ_GC_VAR_IN_REG(1, rest);
2628 MZ_GC_REG();
2629
Bram Moolenaara80faa82020-04-12 19:37:17 +02002630 array = ALLOC_CLEAR_MULT(char *, new_len + 1);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002631
2632 rest = line_list;
2633 for (i = 0; i < new_len; ++i)
2634 {
2635 line = SCHEME_CAR(rest);
2636 rest = SCHEME_CDR(rest);
2637 if (!SCHEME_STRINGP(line))
2638 {
2639 free_array(array);
2640 scheme_wrong_type(prim->name, "string-list", 2, argc, argv);
2641 }
2642 array[i] = string_to_line(line);
2643 }
2644
2645 curbuf = buf->buf;
2646
2647 if (u_save((linenr_T)(lo-1), (linenr_T)hi) == FAIL)
2648 {
2649 curbuf = savebuf;
2650 free_array(array);
2651 raise_vim_exn(_("cannot save undo information"));
2652 }
2653
2654 /*
2655 * If the size of the range is reducing (ie, new_len < old_len) we
2656 * need to delete some old_len. We do this at the start, by
2657 * repeatedly deleting line "lo".
2658 */
2659 for (i = 0; i < old_len - new_len; ++i)
2660 {
Bram Moolenaarca70c072020-05-30 20:30:46 +02002661 if (ml_delete((linenr_T)lo) == FAIL)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002662 {
2663 curbuf = savebuf;
2664 free_array(array);
2665 raise_vim_exn(_("cannot delete line"));
2666 }
2667 extra--;
2668 }
2669
2670 /*
2671 * For as long as possible, replace the existing old_len with the
2672 * new old_len. This is a more efficient operation, as it requires
2673 * less memory allocation and freeing.
2674 */
2675 for (i = 0; i < old_len && i < new_len; i++)
2676 if (ml_replace((linenr_T)(lo+i), (char_u *)array[i], TRUE) == FAIL)
2677 {
2678 curbuf = savebuf;
2679 free_array(array);
2680 raise_vim_exn(_("cannot replace line"));
2681 }
2682
2683 /*
2684 * Now we may need to insert the remaining new_len. We don't need to
2685 * free the string passed back because MzScheme has control of that
2686 * memory.
2687 */
2688 while (i < new_len)
2689 {
2690 if (ml_append((linenr_T)(lo + i - 1),
2691 (char_u *)array[i], 0, FALSE) == FAIL)
2692 {
2693 curbuf = savebuf;
2694 free_array(array);
2695 raise_vim_exn(_("cannot insert line"));
2696 }
2697 ++i;
2698 ++extra;
2699 }
2700 MZ_GC_UNREG();
2701 free_array(array);
2702 }
2703
2704 /*
2705 * Adjust marks. Invalidate any which lie in the
2706 * changed range, and move any in the remainder of the buffer.
2707 */
Bram Moolenaarfd89d7e2016-06-04 20:25:05 +02002708 mark_adjust((linenr_T)lo, (linenr_T)(hi - 1),
2709 (long)MAXLNUM, (long)extra);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002710 changed_lines((linenr_T)lo, 0, (linenr_T)hi, (long)extra);
2711
2712 if (buf->buf == curwin->w_buffer)
2713 mz_fix_cursor(lo, hi, extra);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002714 curbuf = savebuf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002715
2716 MZ_GC_UNREG();
2717 raise_if_error();
2718 return scheme_void;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002719 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002720}
2721
2722/*
2723 * (insert-buff-line-list {linenr} {string/string-list} [buffer])
2724 *
Bram Moolenaar0a1c0ec2009-12-16 18:02:47 +00002725 * Insert a number of lines into the specified buffer after the specified line.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002726 * The line number is in Vim format (1-based). The lines to be inserted are
2727 * given as an MzScheme list of string objects or as a single string. The lines
2728 * to be added are checked for validity and correct format. Errors are
2729 * returned as a value of FAIL. The return value is OK on success.
2730 * If OK is returned and len_change is not NULL, *len_change
2731 * is set to the change in the buffer length.
2732 */
2733 static Scheme_Object *
2734insert_buffer_line_list(void *data, int argc, Scheme_Object **argv)
2735{
2736 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002737 vim_mz_buffer *buf = NULL;
2738 Scheme_Object *list = NULL;
2739 char *str = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002740 int i, n, size;
2741
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002742 MZ_GC_DECL_REG(1);
2743 MZ_GC_VAR_IN_REG(0, list);
2744 MZ_GC_REG();
2745
Bram Moolenaar555b2802005-05-19 21:08:39 +00002746#ifdef HAVE_SANDBOX
2747 sandbox_check();
2748#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002749 /*
2750 * First of all, we check the type of the supplied MzScheme object.
2751 * It must be a string or a list, or the call is in error.
2752 */
2753 n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2754 list = argv[1];
2755
2756 if (!SCHEME_STRINGP(list) && !SCHEME_PAIRP(list))
2757 scheme_wrong_type(prim->name, "string or list", 1, argc, argv);
2758 buf = get_buffer_arg(prim->name, 2, argc, argv);
2759
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002760 if (n != 0) // 0 can be used in insert
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002761 check_line_range(n, buf->buf);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002762 if (SCHEME_STRINGP(list))
2763 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002764 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002765
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002766 str = string_to_line(list);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002767 curbuf = buf->buf;
2768
2769 if (u_save((linenr_T)n, (linenr_T)(n+1)) == FAIL)
2770 {
2771 curbuf = savebuf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002772 vim_free(str);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002773 raise_vim_exn(_("cannot save undo information"));
2774 }
2775 else if (ml_append((linenr_T)n, (char_u *)str, 0, FALSE) == FAIL)
2776 {
2777 curbuf = savebuf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002778 vim_free(str);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002779 raise_vim_exn(_("cannot insert line"));
2780 }
2781 else
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002782 {
2783 vim_free(str);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002784 appended_lines_mark((linenr_T)n, 1L);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002785 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002786
2787 curbuf = savebuf;
Bram Moolenaara4d158b2022-08-14 14:17:45 +01002788 update_screen(UPD_VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002789
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002790 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002791 raise_if_error();
2792 return scheme_void;
2793 }
2794
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002795 // List
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002796 size = scheme_proper_list_length(list);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002797 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002798 if (size < 0) // improper or cyclic list
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002799 scheme_wrong_type(prim->name, "proper list",
2800 2, argc, argv);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002801 else
2802 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002803 Scheme_Object *line = NULL;
2804 Scheme_Object *rest = NULL;
2805 char **array;
2806 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002807
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002808 MZ_GC_DECL_REG(2);
2809 MZ_GC_VAR_IN_REG(0, line);
2810 MZ_GC_VAR_IN_REG(1, rest);
2811 MZ_GC_REG();
2812
Bram Moolenaara80faa82020-04-12 19:37:17 +02002813 array = ALLOC_CLEAR_MULT(char *, size + 1);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002814
2815 rest = list;
2816 for (i = 0; i < size; ++i)
2817 {
2818 line = SCHEME_CAR(rest);
2819 rest = SCHEME_CDR(rest);
2820 array[i] = string_to_line(line);
2821 }
2822
2823 curbuf = buf->buf;
2824
2825 if (u_save((linenr_T)n, (linenr_T)(n + 1)) == FAIL)
2826 {
2827 curbuf = savebuf;
2828 free_array(array);
2829 raise_vim_exn(_("cannot save undo information"));
2830 }
2831 else
2832 {
2833 for (i = 0; i < size; ++i)
2834 if (ml_append((linenr_T)(n + i), (char_u *)array[i],
2835 0, FALSE) == FAIL)
2836 {
2837 curbuf = savebuf;
2838 free_array(array);
2839 raise_vim_exn(_("cannot insert line"));
2840 }
2841
2842 if (i > 0)
2843 appended_lines_mark((linenr_T)n, (long)i);
2844 }
2845 free_array(array);
2846 MZ_GC_UNREG();
2847 curbuf = savebuf;
Bram Moolenaara4d158b2022-08-14 14:17:45 +01002848 update_screen(UPD_VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002849 }
2850
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002851 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002852 raise_if_error();
2853 return scheme_void;
2854}
2855
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002856/*
2857 * Predicates
2858 */
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002859/*
2860 * (buff? obj)
2861 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002862 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002863vim_bufferp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002864{
2865 if (SCHEME_VIMBUFFERP(argv[0]))
2866 return scheme_true;
2867 else
2868 return scheme_false;
2869}
2870
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002871/*
2872 * (win? obj)
2873 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002874 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002875vim_windowp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002876{
2877 if (SCHEME_VIMWINDOWP(argv[0]))
2878 return scheme_true;
2879 else
2880 return scheme_false;
2881}
2882
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002883/*
2884 * (buff-valid? obj)
2885 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002886 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002887vim_buffer_validp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002888{
2889 if (SCHEME_VIMBUFFERP(argv[0])
2890 && ((vim_mz_buffer *)argv[0])->buf != INVALID_BUFFER_VALUE)
2891 return scheme_true;
2892 else
2893 return scheme_false;
2894}
2895
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002896/*
2897 * (win-valid? obj)
2898 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002899 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002900vim_window_validp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002901{
2902 if (SCHEME_VIMWINDOWP(argv[0])
2903 && ((vim_mz_window *)argv[0])->win != INVALID_WINDOW_VALUE)
2904 return scheme_true;
2905 else
2906 return scheme_false;
2907}
2908
2909/*
2910 *===========================================================================
2911 * Utilities
2912 *===========================================================================
2913 */
2914
2915/*
2916 * Convert an MzScheme string into a Vim line.
2917 *
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002918 * All internal nulls are replaced by newline characters.
2919 * It is an error for the string to contain newline characters.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002920 *
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002921 * Returns pointer to Vim allocated memory
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002922 */
2923 static char *
2924string_to_line(Scheme_Object *obj)
2925{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002926 char *scheme_str = NULL;
2927 char *vim_str = NULL;
Bram Moolenaar75676462013-01-30 14:55:42 +01002928 OUTPUT_LEN_TYPE len;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002929 int i;
2930
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002931 scheme_str = scheme_display_to_string(obj, &len);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002932
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002933 // Error checking: String must not contain newlines, as we
2934 // are replacing a single line, and we must replace it with
2935 // a single line.
Bram Moolenaar75676462013-01-30 14:55:42 +01002936 if (memchr(scheme_str, '\n', len))
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002937 scheme_signal_error(_("string cannot contain newlines"));
2938
Bram Moolenaarc799fe22019-05-28 23:08:19 +02002939 vim_str = alloc(len + 1);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002940
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002941 // Create a copy of the string, with internal nulls replaced by
2942 // newline characters, as is the vim convention.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002943 for (i = 0; i < len; ++i)
2944 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002945 if (scheme_str[i] == '\0')
2946 vim_str[i] = '\n';
2947 else
2948 vim_str[i] = scheme_str[i];
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002949 }
2950
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002951 vim_str[i] = '\0';
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002952
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002953 MZ_GC_CHECK();
2954 return vim_str;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002955}
2956
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002957#ifdef FEAT_EVAL
2958/*
2959 * Convert Vim value into MzScheme, adopted from if_python.c
2960 */
2961 static Scheme_Object *
Bram Moolenaar75676462013-01-30 14:55:42 +01002962vim_to_mzscheme(typval_T *vim_value)
2963{
2964 Scheme_Object *result = NULL;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002965 // hash table to store visited values to avoid infinite loops
Bram Moolenaar75676462013-01-30 14:55:42 +01002966 Scheme_Hash_Table *visited = NULL;
2967
2968 MZ_GC_DECL_REG(2);
2969 MZ_GC_VAR_IN_REG(0, result);
2970 MZ_GC_VAR_IN_REG(1, visited);
2971 MZ_GC_REG();
2972
2973 visited = scheme_make_hash_table(SCHEME_hash_ptr);
2974 MZ_GC_CHECK();
2975
2976 result = vim_to_mzscheme_impl(vim_value, 1, visited);
2977
2978 MZ_GC_UNREG();
2979 return result;
2980}
2981
2982 static Scheme_Object *
2983vim_to_mzscheme_impl(typval_T *vim_value, int depth, Scheme_Hash_Table *visited)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002984{
2985 Scheme_Object *result = NULL;
2986 int new_value = TRUE;
2987
Bram Moolenaar75676462013-01-30 14:55:42 +01002988 MZ_GC_DECL_REG(2);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002989 MZ_GC_VAR_IN_REG(0, result);
Bram Moolenaar75676462013-01-30 14:55:42 +01002990 MZ_GC_VAR_IN_REG(1, visited);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002991 MZ_GC_REG();
2992
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002993 // Avoid infinite recursion
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002994 if (depth > 100)
2995 {
2996 MZ_GC_UNREG();
2997 return scheme_void;
2998 }
2999
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003000 // Check if we run into a recursive loop. The item must be in visited
3001 // then and we can use it again.
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003002 result = scheme_hash_get(visited, (Scheme_Object *)vim_value);
3003 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003004 if (result != NULL) // found, do nothing
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003005 new_value = FALSE;
3006 else if (vim_value->v_type == VAR_STRING)
3007 {
Bram Moolenaar75676462013-01-30 14:55:42 +01003008 result = scheme_make_byte_string((char *)vim_value->vval.v_string);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003009 MZ_GC_CHECK();
3010 }
3011 else if (vim_value->v_type == VAR_NUMBER)
3012 {
3013 result = scheme_make_integer((long)vim_value->vval.v_number);
3014 MZ_GC_CHECK();
3015 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003016 else if (vim_value->v_type == VAR_FLOAT)
3017 {
3018 result = scheme_make_double((double)vim_value->vval.v_float);
3019 MZ_GC_CHECK();
3020 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003021 else if (vim_value->v_type == VAR_LIST)
3022 {
3023 list_T *list = vim_value->vval.v_list;
3024 listitem_T *curr;
3025
3026 if (list == NULL || list->lv_first == NULL)
3027 result = scheme_null;
3028 else
3029 {
3030 Scheme_Object *obj = NULL;
3031
3032 MZ_GC_DECL_REG(1);
3033 MZ_GC_VAR_IN_REG(0, obj);
3034 MZ_GC_REG();
3035
Bram Moolenaar0ff6aad2020-01-29 21:27:21 +01003036 curr = list->lv_u.mat.lv_last;
Bram Moolenaar75676462013-01-30 14:55:42 +01003037 obj = vim_to_mzscheme_impl(&curr->li_tv, depth + 1, visited);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003038 result = scheme_make_pair(obj, scheme_null);
3039 MZ_GC_CHECK();
3040
3041 while (curr != list->lv_first)
3042 {
3043 curr = curr->li_prev;
Bram Moolenaar75676462013-01-30 14:55:42 +01003044 obj = vim_to_mzscheme_impl(&curr->li_tv, depth + 1, visited);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003045 result = scheme_make_pair(obj, result);
3046 MZ_GC_CHECK();
3047 }
3048 }
3049 MZ_GC_UNREG();
3050 }
3051 else if (vim_value->v_type == VAR_DICT)
3052 {
3053 Scheme_Object *key = NULL;
3054 Scheme_Object *obj = NULL;
3055
3056 MZ_GC_DECL_REG(2);
3057 MZ_GC_VAR_IN_REG(0, key);
3058 MZ_GC_VAR_IN_REG(1, obj);
3059 MZ_GC_REG();
3060
3061 result = (Scheme_Object *)scheme_make_hash_table(SCHEME_hash_ptr);
3062 MZ_GC_CHECK();
3063 if (vim_value->vval.v_dict != NULL)
3064 {
3065 hashtab_T *ht = &vim_value->vval.v_dict->dv_hashtab;
3066 long_u todo = ht->ht_used;
3067 hashitem_T *hi;
3068 dictitem_T *di;
3069
Yegappan Lakshmanan14113fd2023-03-07 17:13:51 +00003070 FOR_ALL_HASHTAB_ITEMS(ht, hi, todo)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003071 {
3072 if (!HASHITEM_EMPTY(hi))
3073 {
3074 --todo;
3075
3076 di = dict_lookup(hi);
Bram Moolenaar75676462013-01-30 14:55:42 +01003077 obj = vim_to_mzscheme_impl(&di->di_tv, depth + 1, visited);
3078 key = scheme_make_byte_string((char *)hi->hi_key);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003079 MZ_GC_CHECK();
3080 scheme_hash_set((Scheme_Hash_Table *)result, key, obj);
3081 MZ_GC_CHECK();
3082 }
3083 }
3084 }
3085 MZ_GC_UNREG();
3086 }
Bram Moolenaar75676462013-01-30 14:55:42 +01003087 else if (vim_value->v_type == VAR_FUNC)
3088 {
3089 Scheme_Object *funcname = NULL;
3090
3091 MZ_GC_DECL_REG(1);
3092 MZ_GC_VAR_IN_REG(0, funcname);
3093 MZ_GC_REG();
3094
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003095 // FIXME: func_ref() and func_unref() are needed.
Bram Moolenaar75676462013-01-30 14:55:42 +01003096 funcname = scheme_make_byte_string((char *)vim_value->vval.v_string);
3097 MZ_GC_CHECK();
3098 result = scheme_make_closed_prim_w_arity(vim_funcref, funcname,
3099 (const char *)BYTE_STRING_VALUE(funcname), 0, -1);
3100 MZ_GC_CHECK();
3101
3102 MZ_GC_UNREG();
3103 }
Bram Moolenaar67c2c052016-03-30 22:03:02 +02003104 else if (vim_value->v_type == VAR_PARTIAL)
3105 {
3106 if (vim_value->vval.v_partial == NULL)
3107 result = scheme_null;
3108 else
3109 {
3110 Scheme_Object *funcname = NULL;
3111
3112 MZ_GC_DECL_REG(1);
3113 MZ_GC_VAR_IN_REG(0, funcname);
3114 MZ_GC_REG();
3115
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003116 // FIXME: func_ref() and func_unref() are needed.
3117 // TODO: Support pt_dict and pt_argv.
Bram Moolenaar67c2c052016-03-30 22:03:02 +02003118 funcname = scheme_make_byte_string(
Bram Moolenaar437bafe2016-08-01 15:40:54 +02003119 (char *)partial_name(vim_value->vval.v_partial));
Bram Moolenaar67c2c052016-03-30 22:03:02 +02003120 MZ_GC_CHECK();
3121 result = scheme_make_closed_prim_w_arity(vim_funcref, funcname,
3122 (const char *)BYTE_STRING_VALUE(funcname), 0, -1);
3123 MZ_GC_CHECK();
3124
3125 MZ_GC_UNREG();
3126 }
3127 }
Bram Moolenaar9b4a15d2020-01-11 16:05:23 +01003128 else if (vim_value->v_type == VAR_BOOL || vim_value->v_type == VAR_SPECIAL)
Bram Moolenaar520e1e42016-01-23 19:46:28 +01003129 {
3130 if (vim_value->vval.v_number <= VVAL_TRUE)
3131 result = scheme_make_integer((long)vim_value->vval.v_number);
3132 else
3133 result = scheme_null;
3134 MZ_GC_CHECK();
3135 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003136 else
3137 {
3138 result = scheme_void;
3139 new_value = FALSE;
3140 }
3141 if (new_value)
3142 {
3143 scheme_hash_set(visited, (Scheme_Object *)vim_value, result);
3144 MZ_GC_CHECK();
3145 }
3146 MZ_GC_UNREG();
3147 return result;
3148}
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003149
3150 static int
Bram Moolenaar75676462013-01-30 14:55:42 +01003151mzscheme_to_vim(Scheme_Object *obj, typval_T *tv)
3152{
3153 int i, status;
3154 Scheme_Hash_Table *visited = NULL;
3155
3156 MZ_GC_DECL_REG(2);
3157 MZ_GC_VAR_IN_REG(0, obj);
3158 MZ_GC_VAR_IN_REG(1, visited);
3159 MZ_GC_REG();
3160
3161 visited = scheme_make_hash_table(SCHEME_hash_ptr);
3162 MZ_GC_CHECK();
3163
3164 status = mzscheme_to_vim_impl(obj, tv, 1, visited);
3165 for (i = 0; i < visited->size; ++i)
3166 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003167 // free up remembered objects
Bram Moolenaar75676462013-01-30 14:55:42 +01003168 if (visited->vals[i] != NULL)
3169 free_tv((typval_T *)visited->vals[i]);
3170 }
3171
3172 MZ_GC_UNREG();
3173 return status;
3174}
3175 static int
3176mzscheme_to_vim_impl(Scheme_Object *obj, typval_T *tv, int depth,
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003177 Scheme_Hash_Table *visited)
3178{
3179 int status = OK;
3180 typval_T *found;
Bram Moolenaar75676462013-01-30 14:55:42 +01003181
3182 MZ_GC_DECL_REG(2);
3183 MZ_GC_VAR_IN_REG(0, obj);
3184 MZ_GC_VAR_IN_REG(1, visited);
3185 MZ_GC_REG();
3186
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003187 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003188 if (depth > 100) // limit the deepest recursion level
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003189 {
3190 tv->v_type = VAR_NUMBER;
3191 tv->vval.v_number = 0;
3192 return FAIL;
3193 }
3194
3195 found = (typval_T *)scheme_hash_get(visited, obj);
3196 if (found != NULL)
3197 copy_tv(found, tv);
3198 else if (SCHEME_VOIDP(obj))
3199 {
Bram Moolenaar520e1e42016-01-23 19:46:28 +01003200 tv->v_type = VAR_SPECIAL;
3201 tv->vval.v_number = VVAL_NULL;
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003202 }
3203 else if (SCHEME_INTP(obj))
3204 {
3205 tv->v_type = VAR_NUMBER;
3206 tv->vval.v_number = SCHEME_INT_VAL(obj);
3207 }
3208 else if (SCHEME_BOOLP(obj))
3209 {
Bram Moolenaar9b4a15d2020-01-11 16:05:23 +01003210 tv->v_type = VAR_BOOL;
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003211 tv->vval.v_number = SCHEME_TRUEP(obj);
3212 }
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003213 else if (SCHEME_DBLP(obj))
3214 {
3215 tv->v_type = VAR_FLOAT;
3216 tv->vval.v_float = SCHEME_DBL_VAL(obj);
3217 }
Bram Moolenaar75676462013-01-30 14:55:42 +01003218 else if (SCHEME_BYTE_STRINGP(obj))
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003219 {
3220 tv->v_type = VAR_STRING;
Bram Moolenaar75676462013-01-30 14:55:42 +01003221 tv->vval.v_string = vim_strsave(BYTE_STRING_VALUE(obj));
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003222 }
Bram Moolenaar75676462013-01-30 14:55:42 +01003223# if MZSCHEME_VERSION_MAJOR >= 299
3224 else if (SCHEME_CHAR_STRINGP(obj))
3225 {
3226 Scheme_Object *tmp = NULL;
3227 MZ_GC_DECL_REG(1);
3228 MZ_GC_VAR_IN_REG(0, tmp);
3229 MZ_GC_REG();
3230
3231 tmp = scheme_char_string_to_byte_string(obj);
3232 tv->v_type = VAR_STRING;
3233 tv->vval.v_string = vim_strsave(BYTE_STRING_VALUE(tmp));
3234 MZ_GC_UNREG();
3235 }
3236#endif
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003237 else if (SCHEME_VECTORP(obj) || SCHEME_NULLP(obj)
3238 || SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj))
3239 {
3240 list_T *list = list_alloc();
3241 if (list == NULL)
3242 status = FAIL;
3243 else
3244 {
3245 int i;
3246 Scheme_Object *curr = NULL;
3247 Scheme_Object *cval = NULL;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003248 // temporary var to hold current element of vectors and pairs
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003249 typval_T *v;
3250
3251 MZ_GC_DECL_REG(2);
3252 MZ_GC_VAR_IN_REG(0, curr);
3253 MZ_GC_VAR_IN_REG(1, cval);
3254 MZ_GC_REG();
3255
3256 tv->v_type = VAR_LIST;
3257 tv->vval.v_list = list;
3258 ++list->lv_refcount;
3259
Bram Moolenaarc799fe22019-05-28 23:08:19 +02003260 v = ALLOC_ONE(typval_T);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003261 if (v == NULL)
3262 status = FAIL;
3263 else
3264 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003265 // add the value in advance to allow handling of self-referential
3266 // data structures
Bram Moolenaarc799fe22019-05-28 23:08:19 +02003267 typval_T *visited_tv = ALLOC_ONE(typval_T);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003268 copy_tv(tv, visited_tv);
3269 scheme_hash_set(visited, obj, (Scheme_Object *)visited_tv);
3270
3271 if (SCHEME_VECTORP(obj))
3272 {
3273 for (i = 0; i < SCHEME_VEC_SIZE(obj); ++i)
3274 {
3275 cval = SCHEME_VEC_ELS(obj)[i];
Bram Moolenaar75676462013-01-30 14:55:42 +01003276 status = mzscheme_to_vim_impl(cval, v, depth + 1, visited);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003277 if (status == FAIL)
3278 break;
3279 status = list_append_tv(list, v);
3280 clear_tv(v);
3281 if (status == FAIL)
3282 break;
3283 }
3284 }
3285 else if (SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj))
3286 {
3287 for (curr = obj;
3288 SCHEME_PAIRP(curr) || SCHEME_MUTABLE_PAIRP(curr);
3289 curr = SCHEME_CDR(curr))
3290 {
3291 cval = SCHEME_CAR(curr);
Bram Moolenaar75676462013-01-30 14:55:42 +01003292 status = mzscheme_to_vim_impl(cval, v, depth + 1, visited);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003293 if (status == FAIL)
3294 break;
3295 status = list_append_tv(list, v);
3296 clear_tv(v);
3297 if (status == FAIL)
3298 break;
3299 }
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003300 // improper list not terminated with null
3301 // need to handle the last element
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003302 if (status == OK && !SCHEME_NULLP(curr))
3303 {
Bram Moolenaar75676462013-01-30 14:55:42 +01003304 status = mzscheme_to_vim_impl(cval, v, depth + 1, visited);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003305 if (status == OK)
3306 {
3307 status = list_append_tv(list, v);
3308 clear_tv(v);
3309 }
3310 }
3311 }
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003312 // nothing to do for scheme_null
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003313 vim_free(v);
3314 }
3315 MZ_GC_UNREG();
3316 }
3317 }
3318 else if (SCHEME_HASHTP(obj))
3319 {
3320 int i;
3321 dict_T *dict;
3322 Scheme_Object *key = NULL;
3323 Scheme_Object *val = NULL;
3324
3325 MZ_GC_DECL_REG(2);
3326 MZ_GC_VAR_IN_REG(0, key);
3327 MZ_GC_VAR_IN_REG(1, val);
3328 MZ_GC_REG();
3329
3330 dict = dict_alloc();
3331 if (dict == NULL)
3332 status = FAIL;
3333 else
3334 {
Bram Moolenaarc799fe22019-05-28 23:08:19 +02003335 typval_T *visited_tv = ALLOC_ONE(typval_T);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003336
3337 tv->v_type = VAR_DICT;
3338 tv->vval.v_dict = dict;
3339 ++dict->dv_refcount;
3340
3341 copy_tv(tv, visited_tv);
3342 scheme_hash_set(visited, obj, (Scheme_Object *)visited_tv);
3343
3344 for (i = 0; i < ((Scheme_Hash_Table *)obj)->size; ++i)
3345 {
3346 if (((Scheme_Hash_Table *) obj)->vals[i] != NULL)
3347 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003348 // generate item for `display'ed Scheme key
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003349 dictitem_T *item = dictitem_alloc((char_u *)string_to_line(
3350 ((Scheme_Hash_Table *) obj)->keys[i]));
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003351 // convert Scheme val to Vim and add it to the dict
Bram Moolenaar75676462013-01-30 14:55:42 +01003352 if (mzscheme_to_vim_impl(((Scheme_Hash_Table *) obj)->vals[i],
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003353 &item->di_tv, depth + 1, visited) == FAIL
3354 || dict_add(dict, item) == FAIL)
3355 {
3356 dictitem_free(item);
3357 status = FAIL;
3358 break;
3359 }
3360 }
3361
3362 }
3363 }
3364 MZ_GC_UNREG();
3365 }
3366 else
3367 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003368 // `display' any other value to string
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003369 tv->v_type = VAR_STRING;
3370 tv->vval.v_string = (char_u *)string_to_line(obj);
3371 }
Bram Moolenaar75676462013-01-30 14:55:42 +01003372 MZ_GC_UNREG();
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003373 return status;
3374}
3375
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003376/*
3377 * Scheme prim procedure wrapping Vim funcref
3378 */
Bram Moolenaar75676462013-01-30 14:55:42 +01003379 static Scheme_Object *
3380vim_funcref(void *name, int argc, Scheme_Object **argv)
3381{
3382 int i;
3383 typval_T args;
3384 int status = OK;
3385 Scheme_Object *result = NULL;
3386 list_T *list = list_alloc();
3387
3388 MZ_GC_DECL_REG(1);
3389 MZ_GC_VAR_IN_REG(0, result);
3390 MZ_GC_REG();
3391
3392 result = scheme_void;
3393 if (list == NULL)
3394 status = FAIL;
3395 else
3396 {
3397 args.v_type = VAR_LIST;
3398 args.vval.v_list = list;
3399 ++list->lv_refcount;
3400 for (i = 0; status == OK && i < argc; ++i)
3401 {
Bram Moolenaarc799fe22019-05-28 23:08:19 +02003402 typval_T *v = ALLOC_ONE(typval_T);
Bram Moolenaar75676462013-01-30 14:55:42 +01003403 if (v == NULL)
3404 status = FAIL;
3405 else
3406 {
3407 status = mzscheme_to_vim(argv[i], v);
3408 if (status == OK)
3409 {
3410 status = list_append_tv(list, v);
3411 clear_tv(v);
3412 }
3413 vim_free(v);
3414 }
3415 }
3416 if (status == OK)
3417 {
3418 typval_T ret;
3419 ret.v_type = VAR_UNKNOWN;
3420
3421 mzscheme_call_vim(BYTE_STRING_VALUE((Scheme_Object *)name), &args, &ret);
3422 MZ_GC_CHECK();
3423 result = vim_to_mzscheme(&ret);
3424 clear_tv(&ret);
3425 MZ_GC_CHECK();
3426 }
3427 }
3428 clear_tv(&args);
3429 MZ_GC_UNREG();
3430 if (status != OK)
3431 raise_vim_exn(_("error converting Scheme values to Vim"));
3432 else
3433 raise_if_error();
3434 return result;
3435}
3436
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003437 void
3438do_mzeval(char_u *str, typval_T *rettv)
3439{
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003440 Scheme_Object *ret = NULL;
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003441
Bram Moolenaar75676462013-01-30 14:55:42 +01003442 MZ_GC_DECL_REG(1);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003443 MZ_GC_VAR_IN_REG(0, ret);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003444 MZ_GC_REG();
3445
3446 if (mzscheme_init())
3447 {
3448 MZ_GC_UNREG();
3449 return;
3450 }
3451
3452 MZ_GC_CHECK();
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003453 if (eval_with_exn_handling(str, do_eval, &ret) == OK)
Bram Moolenaar75676462013-01-30 14:55:42 +01003454 mzscheme_to_vim(ret, rettv);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003455
3456 MZ_GC_UNREG();
3457}
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003458#endif
3459
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003460/*
3461 * Check to see whether a Vim error has been reported, or a keyboard
3462 * interrupt (from vim --> got_int) has been detected.
3463 */
3464 static int
3465vim_error_check(void)
3466{
3467 return (got_int || did_emsg);
3468}
3469
3470/*
3471 * register Scheme exn:vim
3472 */
3473 static void
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003474register_vim_exn(void)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003475{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003476 int nc = 0;
3477 int i;
3478 Scheme_Object *struct_exn = NULL;
3479 Scheme_Object *exn_name = NULL;
3480
3481 MZ_GC_DECL_REG(2);
3482 MZ_GC_VAR_IN_REG(0, struct_exn);
3483 MZ_GC_VAR_IN_REG(1, exn_name);
3484 MZ_GC_REG();
3485
3486 exn_name = scheme_intern_symbol("exn:vim");
3487 MZ_GC_CHECK();
3488 struct_exn = scheme_builtin_value("struct:exn");
3489 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003490
3491 if (vim_exn == NULL)
3492 vim_exn = scheme_make_struct_type(exn_name,
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003493 struct_exn, NULL, 0, 0, NULL, NULL
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003494#if MZSCHEME_VERSION_MAJOR >= 299
3495 , NULL
3496#endif
3497 );
3498
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003499
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003500 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003501 Scheme_Object **tmp = NULL;
3502 Scheme_Object *exn_names[5] = {NULL, NULL, NULL, NULL, NULL};
3503 Scheme_Object *exn_values[5] = {NULL, NULL, NULL, NULL, NULL};
3504 MZ_GC_DECL_REG(6);
3505 MZ_GC_ARRAY_VAR_IN_REG(0, exn_names, 5);
3506 MZ_GC_ARRAY_VAR_IN_REG(3, exn_values, 5);
3507 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003508
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003509 tmp = scheme_make_struct_names(exn_name, scheme_null, 0, &nc);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003510 mch_memmove(exn_names, tmp, nc * sizeof(Scheme_Object *));
3511 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003512
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003513 tmp = scheme_make_struct_values(vim_exn, exn_names, nc, 0);
3514 mch_memmove(exn_values, tmp, nc * sizeof(Scheme_Object *));
3515 MZ_GC_CHECK();
3516
3517 for (i = 0; i < nc; i++)
3518 {
3519 scheme_add_global_symbol(exn_names[i],
3520 exn_values[i], environment);
3521 MZ_GC_CHECK();
3522 }
3523 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003524 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003525 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003526}
3527
3528/*
3529 * raise exn:vim, may be with additional info string
3530 */
3531 void
3532raise_vim_exn(const char *add_info)
3533{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003534 char *fmt = _("Vim error: ~a");
3535 Scheme_Object *argv[2] = {NULL, NULL};
3536 Scheme_Object *exn = NULL;
Bram Moolenaar75676462013-01-30 14:55:42 +01003537 Scheme_Object *byte_string = NULL;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003538
Bram Moolenaar75676462013-01-30 14:55:42 +01003539 MZ_GC_DECL_REG(5);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003540 MZ_GC_ARRAY_VAR_IN_REG(0, argv, 2);
3541 MZ_GC_VAR_IN_REG(3, exn);
Bram Moolenaar75676462013-01-30 14:55:42 +01003542 MZ_GC_VAR_IN_REG(4, byte_string);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003543 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003544
3545 if (add_info != NULL)
3546 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003547 char *c_string = NULL;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003548 Scheme_Object *info = NULL;
3549
3550 MZ_GC_DECL_REG(3);
3551 MZ_GC_VAR_IN_REG(0, c_string);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003552 MZ_GC_VAR_IN_REG(2, info);
3553 MZ_GC_REG();
3554
Bram Moolenaar75676462013-01-30 14:55:42 +01003555 info = scheme_make_byte_string(add_info);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003556 MZ_GC_CHECK();
Bram Moolenaar9b0ac222016-06-01 20:31:43 +02003557 c_string = scheme_format_utf8(fmt, (int)STRLEN(fmt), 1, &info, NULL);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003558 MZ_GC_CHECK();
Bram Moolenaar75676462013-01-30 14:55:42 +01003559 byte_string = scheme_make_byte_string(c_string);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003560 MZ_GC_CHECK();
3561 argv[0] = scheme_byte_string_to_char_string(byte_string);
Bram Moolenaar555b2802005-05-19 21:08:39 +00003562 SCHEME_SET_IMMUTABLE(argv[0]);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003563 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003564 }
3565 else
Bram Moolenaar75676462013-01-30 14:55:42 +01003566 {
3567 byte_string = scheme_make_byte_string(_("Vim error"));
3568 MZ_GC_CHECK();
3569 argv[0] = scheme_byte_string_to_char_string(byte_string);
3570 MZ_GC_CHECK();
3571 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003572 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003573
Bram Moolenaar049377e2007-05-12 15:32:12 +00003574#if MZSCHEME_VERSION_MAJOR < 360
3575 argv[1] = scheme_current_continuation_marks();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003576 MZ_GC_CHECK();
Bram Moolenaar049377e2007-05-12 15:32:12 +00003577#else
Bram Moolenaarc81e5e72007-05-05 18:24:42 +00003578 argv[1] = scheme_current_continuation_marks(NULL);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003579 MZ_GC_CHECK();
Bram Moolenaar049377e2007-05-12 15:32:12 +00003580#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003581
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003582 exn = scheme_make_struct_instance(vim_exn, 2, argv);
3583 MZ_GC_CHECK();
3584 scheme_raise(exn);
3585 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003586}
3587
3588 void
3589raise_if_error(void)
3590{
3591 if (vim_error_check())
3592 raise_vim_exn(NULL);
3593}
3594
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003595/*
3596 * get buffer:
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003597 * either current
3598 * or passed as argv[argnum] with checks
3599 */
3600 static vim_mz_buffer *
3601get_buffer_arg(const char *fname, int argnum, int argc, Scheme_Object **argv)
3602{
3603 vim_mz_buffer *b;
3604
3605 if (argc < argnum + 1)
3606 return get_vim_curr_buffer();
3607 if (!SCHEME_VIMBUFFERP(argv[argnum]))
3608 scheme_wrong_type(fname, "vim-buffer", argnum, argc, argv);
3609 b = (vim_mz_buffer *)argv[argnum];
3610 (void)get_valid_buffer(argv[argnum]);
3611 return b;
3612}
3613
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003614/*
3615 * get window:
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003616 * either current
3617 * or passed as argv[argnum] with checks
3618 */
3619 static vim_mz_window *
3620get_window_arg(const char *fname, int argnum, int argc, Scheme_Object **argv)
3621{
3622 vim_mz_window *w;
3623
3624 if (argc < argnum + 1)
3625 return get_vim_curr_window();
3626 w = (vim_mz_window *)argv[argnum];
3627 if (!SCHEME_VIMWINDOWP(argv[argnum]))
3628 scheme_wrong_type(fname, "vim-window", argnum, argc, argv);
3629 (void)get_valid_window(argv[argnum]);
3630 return w;
3631}
3632
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003633/*
3634 * get valid Vim buffer from Scheme_Object*
3635 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003636buf_T *get_valid_buffer(void *obj)
3637{
3638 buf_T *buf = ((vim_mz_buffer *)obj)->buf;
3639
3640 if (buf == INVALID_BUFFER_VALUE)
3641 scheme_signal_error(_("buffer is invalid"));
3642 return buf;
3643}
3644
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003645/*
3646 * get valid Vim window from Scheme_Object*
3647 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003648win_T *get_valid_window(void *obj)
3649{
3650 win_T *win = ((vim_mz_window *)obj)->win;
3651 if (win == INVALID_WINDOW_VALUE)
3652 scheme_signal_error(_("window is invalid"));
3653 return win;
3654}
3655
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003656 int
3657mzthreads_allowed(void)
3658{
3659 return mz_threads_allow;
3660}
3661
3662 static int
3663line_in_range(linenr_T lnum, buf_T *buf)
3664{
3665 return (lnum > 0 && lnum <= buf->b_ml.ml_line_count);
3666}
3667
3668 static void
3669check_line_range(linenr_T lnum, buf_T *buf)
3670{
3671 if (!line_in_range(lnum, buf))
3672 scheme_signal_error(_("linenr out of range"));
3673}
3674
3675/*
3676 * Check if deleting lines made the cursor position invalid
3677 * (or you'll get msg from Vim about invalid linenr).
3678 * Changed the lines from "lo" to "hi" and added "extra" lines (negative if
3679 * deleted). Got from if_python.c
3680 */
3681 static void
3682mz_fix_cursor(int lo, int hi, int extra)
3683{
3684 if (curwin->w_cursor.lnum >= lo)
3685 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003686 // Adjust the cursor position if it's in/after the changed
3687 // lines.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003688 if (curwin->w_cursor.lnum >= hi)
3689 {
3690 curwin->w_cursor.lnum += extra;
3691 check_cursor_col();
3692 }
3693 else if (extra < 0)
3694 {
3695 curwin->w_cursor.lnum = lo;
3696 check_cursor();
3697 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003698 else
3699 check_cursor_col();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003700 changed_cline_bef_curs();
3701 }
3702 invalidate_botline();
3703}
3704
3705static Vim_Prim prims[]=
3706{
3707 /*
3708 * Buffer-related commands
3709 */
3710 {get_buffer_line, "get-buff-line", 1, 2},
3711 {set_buffer_line, "set-buff-line", 2, 3},
3712 {get_buffer_line_list, "get-buff-line-list", 2, 3},
3713 {get_buffer_name, "get-buff-name", 0, 1},
3714 {get_buffer_num, "get-buff-num", 0, 1},
3715 {get_buffer_size, "get-buff-size", 0, 1},
3716 {set_buffer_line_list, "set-buff-line-list", 3, 4},
3717 {insert_buffer_line_list, "insert-buff-line-list", 2, 3},
3718 {get_curr_buffer, "curr-buff", 0, 0},
3719 {get_buffer_count, "buff-count", 0, 0},
3720 {get_next_buffer, "get-next-buff", 0, 1},
3721 {get_prev_buffer, "get-prev-buff", 0, 1},
3722 {mzscheme_open_buffer, "open-buff", 1, 1},
3723 {get_buffer_by_name, "get-buff-by-name", 1, 1},
3724 {get_buffer_by_num, "get-buff-by-num", 1, 1},
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003725 /*
3726 * Window-related commands
3727 */
3728 {get_curr_win, "curr-win", 0, 0},
3729 {get_window_count, "win-count", 0, 0},
3730 {get_window_by_num, "get-win-by-num", 1, 1},
3731 {get_window_num, "get-win-num", 0, 1},
3732 {get_window_buffer, "get-win-buffer", 0, 1},
3733 {get_window_height, "get-win-height", 0, 1},
3734 {set_window_height, "set-win-height", 1, 2},
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003735 {get_window_width, "get-win-width", 0, 1},
3736 {set_window_width, "set-win-width", 1, 2},
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003737 {get_cursor, "get-cursor", 0, 1},
3738 {set_cursor, "set-cursor", 1, 2},
3739 {get_window_list, "get-win-list", 0, 1},
3740 /*
3741 * Vim-related commands
3742 */
3743 {vim_command, "command", 1, 1},
3744 {vim_eval, "eval", 1, 1},
3745 {get_range_start, "range-start", 0, 0},
3746 {get_range_end, "range-end", 0, 0},
3747 {mzscheme_beep, "beep", 0, 0},
3748 {get_option, "get-option", 1, 2},
3749 {set_option, "set-option", 1, 2},
3750 /*
3751 * small utilities
3752 */
3753 {vim_bufferp, "buff?", 1, 1},
3754 {vim_windowp, "win?", 1, 1},
3755 {vim_buffer_validp, "buff-valid?", 1, 1},
3756 {vim_window_validp, "win-valid?", 1, 1}
3757};
3758
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003759/*
3760 * return MzScheme wrapper for curbuf
3761 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003762 static vim_mz_buffer *
3763get_vim_curr_buffer(void)
3764{
Bram Moolenaare344bea2005-09-01 20:46:49 +00003765 if (curbuf->b_mzscheme_ref == NULL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003766 return (vim_mz_buffer *)buffer_new(curbuf);
3767 else
Bram Moolenaar75676462013-01-30 14:55:42 +01003768 return BUFFER_REF(curbuf);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003769}
3770
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003771/*
3772 * return MzScheme wrapper for curwin
3773 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003774 static vim_mz_window *
3775get_vim_curr_window(void)
3776{
Bram Moolenaare344bea2005-09-01 20:46:49 +00003777 if (curwin->w_mzscheme_ref == NULL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003778 return (vim_mz_window *)window_new(curwin);
3779 else
Bram Moolenaar75676462013-01-30 14:55:42 +01003780 return WINDOW_REF(curwin);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003781}
3782
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003783 static void
Bram Moolenaar68c2f632016-01-30 17:24:07 +01003784make_modules(void)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003785{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003786 int i;
3787 Scheme_Env *mod = NULL;
3788 Scheme_Object *vimext_symbol = NULL;
3789 Scheme_Object *closed_prim = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003790
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003791 MZ_GC_DECL_REG(3);
3792 MZ_GC_VAR_IN_REG(0, mod);
3793 MZ_GC_VAR_IN_REG(1, vimext_symbol);
3794 MZ_GC_VAR_IN_REG(2, closed_prim);
3795 MZ_GC_REG();
3796
3797 vimext_symbol = scheme_intern_symbol("vimext");
3798 MZ_GC_CHECK();
3799 mod = scheme_primitive_module(vimext_symbol, environment);
3800 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003801 // all prims made closed so they can access their own names
K.Takataeeec2542021-06-02 13:28:16 +02003802 for (i = 0; i < (int)ARRAY_LENGTH(prims); i++)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003803 {
3804 Vim_Prim *prim = prims + i;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003805 closed_prim = scheme_make_closed_prim_w_arity(prim->prim, prim, prim->name,
3806 prim->mina, prim->maxa);
3807 scheme_add_global(prim->name, closed_prim, mod);
3808 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003809 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003810 scheme_finish_primitive_module(mod);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003811 MZ_GC_CHECK();
3812 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003813}
Bram Moolenaard857f0e2005-06-21 22:37:39 +00003814
Bram Moolenaar555b2802005-05-19 21:08:39 +00003815#ifdef HAVE_SANDBOX
3816static Scheme_Object *M_write = NULL;
3817static Scheme_Object *M_read = NULL;
3818static Scheme_Object *M_execute = NULL;
3819static Scheme_Object *M_delete = NULL;
3820
3821 static void
Bram Moolenaarc81e5e72007-05-05 18:24:42 +00003822sandbox_check(void)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003823{
3824 if (sandbox)
3825 raise_vim_exn(_("not allowed in the Vim sandbox"));
3826}
3827
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003828/*
3829 * security guards to force Vim's sandbox restrictions on MzScheme level
3830 */
Bram Moolenaar555b2802005-05-19 21:08:39 +00003831 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02003832sandbox_file_guard(int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003833{
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00003834 if (!sandbox)
3835 return scheme_void;
3836
3837 Scheme_Object *requested_access = argv[2];
3838
3839 if (M_write == NULL)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003840 {
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00003841 MZ_REGISTER_STATIC(M_write);
3842 M_write = scheme_intern_symbol("write");
3843 MZ_GC_CHECK();
Bram Moolenaar555b2802005-05-19 21:08:39 +00003844 }
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00003845 if (M_read == NULL)
3846 {
3847 MZ_REGISTER_STATIC(M_read);
3848 M_read = scheme_intern_symbol("read");
3849 MZ_GC_CHECK();
3850 }
3851 if (M_execute == NULL)
3852 {
3853 MZ_REGISTER_STATIC(M_execute);
3854 M_execute = scheme_intern_symbol("execute");
3855 MZ_GC_CHECK();
3856 }
3857 if (M_delete == NULL)
3858 {
3859 MZ_REGISTER_STATIC(M_delete);
3860 M_delete = scheme_intern_symbol("delete");
3861 MZ_GC_CHECK();
3862 }
3863
3864 while (!SCHEME_NULLP(requested_access))
3865 {
3866 Scheme_Object *item = SCHEME_CAR(requested_access);
3867 if (scheme_eq(item, M_write) || scheme_eq(item, M_read)
3868 || scheme_eq(item, M_execute) || scheme_eq(item, M_delete))
3869 raise_vim_exn(_("not allowed in the Vim sandbox"));
3870 requested_access = SCHEME_CDR(requested_access);
3871 }
3872
Bram Moolenaar555b2802005-05-19 21:08:39 +00003873 return scheme_void;
3874}
3875
3876 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02003877sandbox_network_guard(int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003878{
3879 return scheme_void;
3880}
3881#endif
Bram Moolenaar76b92b22006-03-24 22:46:53 +00003882
3883#endif