blob: 39d1530fe5539ad0e53864e2fbf7cd1b44a58874 [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
Yegappan Lakshmananaf936912023-02-20 12:16:39 +0000889 char *
890did_set_mzquantum(void)
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000891{
Yegappan Lakshmananaf936912023-02-20 12:16:39 +0000892 // reset timer
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000893 if (timer_id != 0)
894 remove_timer();
895 if (mz_threads_allow && p_mzq > 0 && gui.in_use)
896 setup_timer();
Yegappan Lakshmananaf936912023-02-20 12:16:39 +0000897 return NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000898}
899
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100900#endif // MZSCHEME_GUI_THREADS
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000901
902 static void
903notify_multithread(int on)
904{
905 mz_threads_allow = on;
Bram Moolenaar2df6dcc2004-07-12 15:53:54 +0000906#ifdef MZSCHEME_GUI_THREADS
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000907 if (on && timer_id == 0 && p_mzq > 0 && gui.in_use)
908 setup_timer();
909 if (!on && timer_id != 0)
910 remove_timer();
911#endif
912}
913
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000914 void
915mzscheme_end(void)
916{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100917 // We can not unload the DLL. Racket's thread might be still alive.
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100918#if 0
Bram Moolenaar33570922005-01-25 22:26:29 +0000919#ifdef DYNAMIC_MZSCHEME
920 dynamic_mzscheme_end();
921#endif
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100922#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +0000923}
924
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100925#if HAVE_TLS_SPACE
926# if defined(_MSC_VER)
Bram Moolenaar2d0860d2010-11-03 21:59:30 +0100927static __declspec(thread) void *tls_space;
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100928extern intptr_t _tls_index;
929# elif defined(__MINGW32__)
930static __thread void *tls_space;
931extern intptr_t _tls_index;
932# else
933static THREAD_LOCAL void *tls_space;
934static intptr_t _tls_index = 0;
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100935# endif
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100936#endif
937
Bram Moolenaar54b63522016-08-26 12:55:09 +0200938/*
939 * mzscheme_main() is called early in main().
940 * We may call scheme_main_setup() which calls mzscheme_env_main() which then
941 * trampolines into vim_main2(), which never returns.
942 */
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100943 int
Bram Moolenaar54b63522016-08-26 12:55:09 +0200944mzscheme_main(void)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000945{
Bram Moolenaara8e691d2016-08-07 15:19:26 +0200946 int argc = 0;
947 char *argv = NULL;
948
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100949#ifdef DYNAMIC_MZSCHEME
950 /*
951 * Racket requires trampolined startup. We can not load it later.
952 * If dynamic dll loading is failed, disable it.
953 */
954 if (!mzscheme_enabled(FALSE))
955 {
956 disabled = TRUE;
Bram Moolenaara8e691d2016-08-07 15:19:26 +0200957 return vim_main2();
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100958 }
959#endif
Bram Moolenaar5c5c9802015-07-10 16:12:48 +0200960#ifdef HAVE_TLS_SPACE
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100961 scheme_register_tls_space(&tls_space, _tls_index);
Bram Moolenaar2d0860d2010-11-03 21:59:30 +0100962#endif
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100963#ifdef TRAMPOLINED_MZVIM_STARTUP
Bram Moolenaara8e691d2016-08-07 15:19:26 +0200964 return scheme_main_setup(TRUE, mzscheme_env_main, argc, &argv);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000965#else
Bram Moolenaara8e691d2016-08-07 15:19:26 +0200966 return mzscheme_env_main(NULL, argc, &argv);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000967#endif
968}
969
970 static int
Bram Moolenaar54b63522016-08-26 12:55:09 +0200971mzscheme_env_main(Scheme_Env *env, int argc UNUSED, char **argv UNUSED)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000972{
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100973#ifdef TRAMPOLINED_MZVIM_STARTUP
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100974 // Scheme has created the environment for us
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100975 environment = env;
976#else
977# ifdef MZ_PRECISE_GC
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000978 Scheme_Object *dummy = NULL;
979 MZ_GC_DECL_REG(1);
980 MZ_GC_VAR_IN_REG(0, dummy);
981
982 stack_base = &__gc_var_stack__;
983# else
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000984 int dummy = 0;
985 stack_base = (void *)&dummy;
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100986# endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000987#endif
Bram Moolenaarbbc98db2012-02-12 01:55:55 +0100988
Bram Moolenaar54b63522016-08-26 12:55:09 +0200989 vim_main2();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +0100990 // not reached, vim_main2() will loop until exit()
Bram Moolenaar54b63522016-08-26 12:55:09 +0200991
992 return 0;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +0000993}
994
Bram Moolenaar4e640bd2016-01-16 16:20:38 +0100995 static Scheme_Object*
996load_base_module(void *data)
997{
998 scheme_namespace_require(scheme_intern_symbol((char *)data));
999 return scheme_null;
1000}
1001
1002 static Scheme_Object *
Bram Moolenaar8b29aba2016-03-28 22:17:16 +02001003load_base_module_on_error(void *data UNUSED)
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001004{
1005 load_base_module_failed = TRUE;
1006 return scheme_null;
1007}
1008
1009 static int
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001010startup_mzscheme(void)
1011{
Bram Moolenaarbbc98db2012-02-12 01:55:55 +01001012#ifndef TRAMPOLINED_MZVIM_STARTUP
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001013 scheme_set_stack_base(stack_base, 1);
1014#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001015
Bram Moolenaar75676462013-01-30 14:55:42 +01001016#ifndef TRAMPOLINED_MZVIM_STARTUP
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001017 // in newer versions of precise GC the initial env has been created
Bram Moolenaar75676462013-01-30 14:55:42 +01001018 environment = scheme_basic_env();
1019#endif
1020
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001021 MZ_REGISTER_STATIC(environment);
1022 MZ_REGISTER_STATIC(curout);
1023 MZ_REGISTER_STATIC(curerr);
1024 MZ_REGISTER_STATIC(exn_catching_apply);
1025 MZ_REGISTER_STATIC(exn_p);
1026 MZ_REGISTER_STATIC(exn_message);
1027 MZ_REGISTER_STATIC(vim_exn);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001028
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001029 MZ_GC_CHECK();
1030
1031#ifdef INCLUDE_MZSCHEME_BASE
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001032 // invoke function from generated and included mzscheme_base.c
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001033 declare_modules(environment);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001034#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001035
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001036 // setup 'current-library-collection-paths' parameter
Bram Moolenaare2a49d82007-07-06 17:43:08 +00001037# if MZSCHEME_VERSION_MAJOR >= 299
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001038 {
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001039 Scheme_Object *coll_path = NULL;
1040 int mustfree = FALSE;
1041 char_u *s;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001042
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001043 MZ_GC_DECL_REG(1);
1044 MZ_GC_VAR_IN_REG(0, coll_path);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001045 MZ_GC_REG();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001046 // workaround for dynamic loading on windows
Bram Moolenaar74a97b12016-02-18 21:19:21 +01001047 s = vim_getenv((char_u *)"PLTCOLLECTS", &mustfree);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001048 if (s != NULL)
1049 {
Bram Moolenaar74a97b12016-02-18 21:19:21 +01001050 coll_path = scheme_make_path((char *)s);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001051 MZ_GC_CHECK();
1052 if (mustfree)
1053 vim_free(s);
1054 }
1055# ifdef MZSCHEME_COLLECTS
1056 if (coll_path == NULL)
1057 {
1058 coll_path = scheme_make_path(MZSCHEME_COLLECTS);
1059 MZ_GC_CHECK();
1060 }
Bram Moolenaar39d7d512013-01-31 21:09:15 +01001061# endif
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001062 if (coll_path != NULL)
1063 {
1064 scheme_set_collects_path(coll_path);
1065 MZ_GC_CHECK();
1066 }
1067 MZ_GC_UNREG();
1068 }
Bram Moolenaare2a49d82007-07-06 17:43:08 +00001069# else
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001070# ifdef MZSCHEME_COLLECTS
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001071 {
1072 Scheme_Object *coll_string = NULL;
1073 Scheme_Object *coll_pair = NULL;
1074 Scheme_Config *config = NULL;
1075
1076 MZ_GC_DECL_REG(3);
1077 MZ_GC_VAR_IN_REG(0, coll_string);
1078 MZ_GC_VAR_IN_REG(1, coll_pair);
1079 MZ_GC_VAR_IN_REG(2, config);
1080 MZ_GC_REG();
Bram Moolenaar75676462013-01-30 14:55:42 +01001081 coll_string = scheme_make_byte_string(MZSCHEME_COLLECTS);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001082 MZ_GC_CHECK();
1083 coll_pair = scheme_make_pair(coll_string, scheme_null);
1084 MZ_GC_CHECK();
Bram Moolenaar75676462013-01-30 14:55:42 +01001085 config = scheme_current_config();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001086 MZ_GC_CHECK();
1087 scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair);
1088 MZ_GC_CHECK();
1089 MZ_GC_UNREG();
1090 }
Bram Moolenaare2a49d82007-07-06 17:43:08 +00001091# endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001092#endif
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001093
1094# if MZSCHEME_VERSION_MAJOR >= 600
1095 {
1096 Scheme_Object *config_path = NULL;
1097 int mustfree = FALSE;
1098 char_u *s;
1099
1100 MZ_GC_DECL_REG(1);
1101 MZ_GC_VAR_IN_REG(0, config_path);
1102 MZ_GC_REG();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001103 // workaround for dynamic loading on windows
Bram Moolenaar5b7d1772016-06-13 19:54:22 +02001104 s = vim_getenv((char_u *)"PLTCONFIGDIR", &mustfree);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001105 if (s != NULL)
1106 {
Bram Moolenaar5b7d1772016-06-13 19:54:22 +02001107 config_path = scheme_make_path((char *)s);
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001108 MZ_GC_CHECK();
1109 if (mustfree)
1110 vim_free(s);
1111 }
1112#ifdef MZSCHEME_CONFIGDIR
1113 if (config_path == NULL)
1114 {
1115 config_path = scheme_make_path(MZSCHEME_CONFIGDIR);
1116 MZ_GC_CHECK();
1117 }
1118#endif
1119 if (config_path != NULL)
1120 {
1121 scheme_set_config_path(config_path);
1122 MZ_GC_CHECK();
1123 }
1124 MZ_GC_UNREG();
1125 }
1126# endif
1127
1128#if MZSCHEME_VERSION_MAJOR >= 400
1129 scheme_init_collection_paths(environment, scheme_null);
1130#endif
1131
1132 /*
1133 * versions 4.x do not provide Scheme bindings by default
1134 * we need to add them explicitly
1135 */
1136 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001137 // use error handler to avoid abort
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001138 scheme_dynamic_wind(NULL, load_base_module, NULL,
1139 load_base_module_on_error, "racket/base");
1140 if (load_base_module_failed)
1141 {
1142 load_base_module_failed = FALSE;
1143 scheme_dynamic_wind(NULL, load_base_module, NULL,
1144 load_base_module_on_error, "scheme/base");
1145 if (load_base_module_failed)
1146 return -1;
1147 }
1148 }
1149
1150 register_vim_exn();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001151 // use new environment to initialise exception handling
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001152 init_exn_catching_apply();
1153
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001154 // redirect output
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001155 scheme_console_output = do_output;
1156 scheme_console_printf = do_printf;
1157
Bram Moolenaar555b2802005-05-19 21:08:39 +00001158#ifdef HAVE_SANDBOX
Bram Moolenaar555b2802005-05-19 21:08:39 +00001159 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001160 Scheme_Object *make_security_guard = NULL;
1161 MZ_GC_DECL_REG(1);
1162 MZ_GC_VAR_IN_REG(0, make_security_guard);
1163 MZ_GC_REG();
1164
1165#if MZSCHEME_VERSION_MAJOR < 400
1166 {
1167 Scheme_Object *make_security_guard_symbol = NULL;
1168 MZ_GC_DECL_REG(1);
1169 MZ_GC_VAR_IN_REG(0, make_security_guard_symbol);
1170 MZ_GC_REG();
1171 make_security_guard_symbol = scheme_intern_symbol("make-security-guard");
1172 MZ_GC_CHECK();
1173 make_security_guard = scheme_lookup_global(
1174 make_security_guard_symbol, environment);
1175 MZ_GC_UNREG();
1176 }
1177#else
1178 make_security_guard = scheme_builtin_value("make-security-guard");
1179 MZ_GC_CHECK();
1180#endif
1181
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001182 // setup sandbox guards
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001183 if (make_security_guard != NULL)
1184 {
1185 Scheme_Object *args[3] = {NULL, NULL, NULL};
1186 Scheme_Object *guard = NULL;
1187 Scheme_Config *config = NULL;
1188 MZ_GC_DECL_REG(5);
1189 MZ_GC_ARRAY_VAR_IN_REG(0, args, 3);
1190 MZ_GC_VAR_IN_REG(3, guard);
1191 MZ_GC_VAR_IN_REG(4, config);
1192 MZ_GC_REG();
Bram Moolenaar75676462013-01-30 14:55:42 +01001193 config = scheme_current_config();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001194 MZ_GC_CHECK();
1195 args[0] = scheme_get_param(config, MZCONFIG_SECURITY_GUARD);
1196 MZ_GC_CHECK();
1197 args[1] = scheme_make_prim_w_arity(sandbox_file_guard,
1198 "sandbox-file-guard", 3, 3);
1199 args[2] = scheme_make_prim_w_arity(sandbox_network_guard,
1200 "sandbox-network-guard", 4, 4);
1201 guard = scheme_apply(make_security_guard, 3, args);
1202 MZ_GC_CHECK();
1203 scheme_set_param(config, MZCONFIG_SECURITY_GUARD, guard);
1204 MZ_GC_CHECK();
1205 MZ_GC_UNREG();
1206 }
1207 MZ_GC_UNREG();
Bram Moolenaar555b2802005-05-19 21:08:39 +00001208 }
1209#endif
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001210 // Create buffer and window types for use in Scheme code
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001211 mz_buffer_type = scheme_make_type("<vim-buffer>");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001212 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001213 mz_window_type = scheme_make_type("<vim-window>");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001214 MZ_GC_CHECK();
1215#ifdef MZ_PRECISE_GC
1216 GC_register_traversers(mz_buffer_type,
1217 buffer_size_proc, buffer_mark_proc, buffer_fixup_proc,
1218 TRUE, TRUE);
1219 GC_register_traversers(mz_window_type,
1220 window_size_proc, window_mark_proc, window_fixup_proc,
1221 TRUE, TRUE);
1222#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001223
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001224 make_modules();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001225
1226 /*
1227 * setup callback to receive notifications
1228 * whether thread scheduling is (or not) required
1229 */
1230 scheme_notify_multithread = notify_multithread;
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001231
1232 return 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001233}
1234
1235/*
1236 * This routine is called for each new invocation of MzScheme
1237 * to make sure things are properly initialized.
1238 */
1239 static int
1240mzscheme_init(void)
1241{
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001242 if (!initialized)
1243 {
Bram Moolenaar33570922005-01-25 22:26:29 +00001244#ifdef DYNAMIC_MZSCHEME
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001245 if (disabled || !mzscheme_enabled(TRUE))
Bram Moolenaar33570922005-01-25 22:26:29 +00001246 {
Bram Moolenaar9d00e4a2022-01-05 17:49:15 +00001247 emsg(_(e_sorry_this_command_is_disabled_the_mzscheme_libraries_could_not_be_loaded));
Bram Moolenaar33570922005-01-25 22:26:29 +00001248 return -1;
1249 }
1250#endif
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001251 if (load_base_module_failed || startup_mzscheme())
1252 {
Bram Moolenaard82a47d2022-01-05 20:24:39 +00001253 emsg(_(e_sorry_this_command_is_disabled_the_mzscheme_racket_base_module_could_not_be_loaded));
Bram Moolenaar4e640bd2016-01-16 16:20:38 +01001254 return -1;
1255 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001256 initialized = TRUE;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001257 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001258 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001259 Scheme_Config *config = NULL;
1260 MZ_GC_DECL_REG(1);
1261 MZ_GC_VAR_IN_REG(0, config);
1262 MZ_GC_REG();
Bram Moolenaar75676462013-01-30 14:55:42 +01001263 config = scheme_current_config();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001264 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001265 // recreate ports each call effectively clearing these ones
Bram Moolenaar75676462013-01-30 14:55:42 +01001266 curout = scheme_make_byte_string_output_port();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001267 MZ_GC_CHECK();
Bram Moolenaar75676462013-01-30 14:55:42 +01001268 curerr = scheme_make_byte_string_output_port();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001269 MZ_GC_CHECK();
1270 scheme_set_param(config, MZCONFIG_OUTPUT_PORT, curout);
1271 MZ_GC_CHECK();
1272 scheme_set_param(config, MZCONFIG_ERROR_PORT, curerr);
1273 MZ_GC_CHECK();
1274 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001275 }
1276
1277 return 0;
1278}
1279
1280/*
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001281 *========================================================================
1282 * 2. External Interface
1283 *========================================================================
1284 */
1285
1286/*
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001287 * Evaluate command with exception handling
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001288 */
1289 static int
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001290eval_with_exn_handling(void *data, Scheme_Closed_Prim *what, Scheme_Object **ret)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001291{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001292 Scheme_Object *value = NULL;
1293 Scheme_Object *exn = NULL;
1294 Scheme_Object *prim = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001295
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001296 MZ_GC_DECL_REG(3);
1297 MZ_GC_VAR_IN_REG(0, value);
1298 MZ_GC_VAR_IN_REG(1, exn);
1299 MZ_GC_VAR_IN_REG(2, prim);
1300 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001301
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001302 prim = scheme_make_closed_prim_w_arity(what, data, "mzvim", 0, 0);
1303 MZ_GC_CHECK();
1304 value = _apply_thunk_catch_exceptions(prim, &exn);
1305 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001306
1307 if (!value)
1308 {
1309 value = extract_exn_message(exn);
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001310 // Got an exn?
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001311 if (value)
1312 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001313 scheme_display(value, curerr); // Send to stderr-vim
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001314 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001315 do_flush();
1316 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001317 MZ_GC_UNREG();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001318 // `raise' was called on some arbitrary value
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001319 return FAIL;
1320 }
1321
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001322 if (ret != NULL) // if pointer to retval supported give it up
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001323 *ret = value;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001324 // Print any result, as long as it's not a void
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001325 else if (!SCHEME_VOIDP(value))
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001326 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001327 scheme_display(value, curout); // Send to stdout-vim
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001328 MZ_GC_CHECK();
1329 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001330
1331 do_flush();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001332 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001333 return OK;
1334}
1335
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001336/*
1337 * :mzscheme
1338 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001339 static int
1340do_mzscheme_command(exarg_T *eap, void *data, Scheme_Closed_Prim *what)
1341{
1342 if (mzscheme_init())
1343 return FAIL;
1344
1345 range_start = eap->line1;
1346 range_end = eap->line2;
1347
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001348 return eval_with_exn_handling(data, what, NULL);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001349}
1350
1351/*
1352 * Routine called by VIM when deleting a buffer
1353 */
1354 void
1355mzscheme_buffer_free(buf_T *buf)
1356{
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001357 if (buf->b_mzscheme_ref == NULL)
1358 return;
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001359
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001360 vim_mz_buffer *bp = NULL;
1361 MZ_GC_DECL_REG(1);
1362 MZ_GC_VAR_IN_REG(0, bp);
1363 MZ_GC_REG();
1364
1365 bp = BUFFER_REF(buf);
1366 bp->buf = INVALID_BUFFER_VALUE;
Bram Moolenaar75676462013-01-30 14:55:42 +01001367#ifndef MZ_PRECISE_GC
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001368 scheme_gc_ptr_ok(bp);
Bram Moolenaar75676462013-01-30 14:55:42 +01001369#else
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001370 scheme_free_immobile_box(buf->b_mzscheme_ref);
Bram Moolenaar75676462013-01-30 14:55:42 +01001371#endif
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001372 buf->b_mzscheme_ref = NULL;
1373 MZ_GC_CHECK();
1374 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001375}
1376
1377/*
1378 * Routine called by VIM when deleting a Window
1379 */
1380 void
1381mzscheme_window_free(win_T *win)
1382{
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001383 if (win->w_mzscheme_ref == NULL)
1384 return;
1385
1386 vim_mz_window *wp = NULL;
1387 MZ_GC_DECL_REG(1);
1388 MZ_GC_VAR_IN_REG(0, wp);
1389 MZ_GC_REG();
1390 wp = WINDOW_REF(win);
1391 wp->win = INVALID_WINDOW_VALUE;
Bram Moolenaar75676462013-01-30 14:55:42 +01001392#ifndef MZ_PRECISE_GC
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001393 scheme_gc_ptr_ok(wp);
Bram Moolenaar75676462013-01-30 14:55:42 +01001394#else
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001395 scheme_free_immobile_box(win->w_mzscheme_ref);
Bram Moolenaar75676462013-01-30 14:55:42 +01001396#endif
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001397 win->w_mzscheme_ref = NULL;
1398 MZ_GC_CHECK();
1399 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001400}
1401
1402/*
1403 * ":mzscheme" (or ":mz")
1404 */
1405 void
1406ex_mzscheme(exarg_T *eap)
1407{
1408 char_u *script;
1409
1410 script = script_get(eap, eap->arg);
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001411 if (eap->skip)
1412 return;
1413
1414 if (script == NULL)
1415 do_mzscheme_command(eap, eap->arg, do_eval);
1416 else
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001417 {
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001418 do_mzscheme_command(eap, script, do_eval);
1419 vim_free(script);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001420 }
1421}
1422
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001423 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001424do_load(void *data, int noargc UNUSED, Scheme_Object **noargv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001425{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001426 Scheme_Object *expr = NULL;
1427 Scheme_Object *result = NULL;
1428 char *file = NULL;
1429 Port_Info *pinfo = (Port_Info *)data;
1430
1431 MZ_GC_DECL_REG(3);
1432 MZ_GC_VAR_IN_REG(0, expr);
1433 MZ_GC_VAR_IN_REG(1, result);
1434 MZ_GC_VAR_IN_REG(2, file);
1435 MZ_GC_REG();
1436
1437 file = (char *)scheme_malloc_fail_ok(scheme_malloc_atomic, MAXPATHL + 1);
1438 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001439
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001440 // make Vim expansion
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001441 expand_env((char_u *)pinfo->name, (char_u *)file, MAXPATHL);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001442 pinfo->port = scheme_open_input_file(file, "mzfile");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001443 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001444 scheme_count_lines(pinfo->port); // to get accurate read error location
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001445 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001446
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001447 // Like REPL but print only last result
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001448 while (!SCHEME_EOFP(expr = scheme_read(pinfo->port)))
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001449 {
1450 result = scheme_eval(expr, environment);
1451 MZ_GC_CHECK();
1452 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001453
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001454 // errors will be caught in do_mzscheme_command and ex_mzfile
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001455 scheme_close_input_port(pinfo->port);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001456 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001457 pinfo->port = NULL;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001458 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001459 return result;
1460}
1461
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001462/*
1463 * :mzfile
1464 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001465 void
1466ex_mzfile(exarg_T *eap)
1467{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001468 Port_Info pinfo = {NULL, NULL};
1469
1470 MZ_GC_DECL_REG(1);
1471 MZ_GC_VAR_IN_REG(0, pinfo.port);
1472 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001473
1474 pinfo.name = (char *)eap->arg;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001475 if (do_mzscheme_command(eap, &pinfo, do_load) != OK
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001476 && pinfo.port != NULL) // looks like port was not closed
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001477 {
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001478 scheme_close_input_port(pinfo.port);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001479 MZ_GC_CHECK();
1480 }
1481 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001482}
1483
1484
1485/*
1486 *========================================================================
1487 * Exception handling code -- cribbed form the MzScheme sources and
1488 * Matthew Flatt's "Inside PLT MzScheme" document.
1489 *========================================================================
1490 */
1491 static void
1492init_exn_catching_apply(void)
1493{
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001494 if (exn_catching_apply)
1495 return;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001496
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00001497 char *e =
1498 "(lambda (thunk) "
1499 "(with-handlers ([void (lambda (exn) (cons #f exn))]) "
1500 "(cons #t (thunk))))";
1501
1502 exn_catching_apply = scheme_eval_string(e, environment);
1503 MZ_GC_CHECK();
1504 exn_p = scheme_builtin_value("exn?");
1505 MZ_GC_CHECK();
1506 exn_message = scheme_builtin_value("exn-message");
1507 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001508}
1509
1510/*
1511 * This function applies a thunk, returning the Scheme value if there's
1512 * no exception, otherwise returning NULL and setting *exn to the raised
1513 * value (usually an exn structure).
1514 */
1515 static Scheme_Object *
1516_apply_thunk_catch_exceptions(Scheme_Object *f, Scheme_Object **exn)
1517{
1518 Scheme_Object *v;
1519
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001520 v = _scheme_apply(exn_catching_apply, 1, &f);
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001521 // v is a pair: (cons #t value) or (cons #f exn)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001522
1523 if (SCHEME_TRUEP(SCHEME_CAR(v)))
1524 return SCHEME_CDR(v);
1525 else
1526 {
1527 *exn = SCHEME_CDR(v);
1528 return NULL;
1529 }
1530}
1531
1532 static Scheme_Object *
1533extract_exn_message(Scheme_Object *v)
1534{
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001535 if (SCHEME_TRUEP(_scheme_apply(exn_p, 1, &v)))
1536 return _scheme_apply(exn_message, 1, &v);
1537 else
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001538 return NULL; // Not an exn structure
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001539}
1540
1541 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001542do_eval(void *s, int noargc UNUSED, Scheme_Object **noargv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001543{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001544 return scheme_eval_string_all((char *)s, environment, TRUE);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001545}
1546
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001547/*
1548 *========================================================================
1549 * 3. MzScheme I/O Handlers
1550 *========================================================================
1551 */
1552 static void
Bram Moolenaar64404472010-06-26 06:24:45 +02001553do_intrnl_output(char *mesg, int error)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001554{
1555 char *p, *prev;
1556
1557 prev = mesg;
1558 p = strchr(prev, '\n');
1559 while (p)
1560 {
1561 *p = '\0';
1562 if (error)
Bram Moolenaarf9e3e092019-01-13 23:38:42 +01001563 emsg(prev);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001564 else
Bram Moolenaar32526b32019-01-19 17:43:09 +01001565 msg(prev);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001566 prev = p + 1;
1567 p = strchr(prev, '\n');
1568 }
1569
1570 if (error)
Bram Moolenaarf9e3e092019-01-13 23:38:42 +01001571 emsg(prev);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001572 else
Bram Moolenaar32526b32019-01-19 17:43:09 +01001573 msg(prev);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001574}
1575
1576 static void
Bram Moolenaar75676462013-01-30 14:55:42 +01001577do_output(char *mesg, OUTPUT_LEN_TYPE len UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001578{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001579 // TODO: use len, the string may not be NUL terminated
Bram Moolenaar64404472010-06-26 06:24:45 +02001580 do_intrnl_output(mesg, 0);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001581}
1582
1583 static void
Bram Moolenaar64404472010-06-26 06:24:45 +02001584do_err_output(char *mesg)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001585{
Bram Moolenaar64404472010-06-26 06:24:45 +02001586 do_intrnl_output(mesg, 1);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001587}
1588
1589 static void
1590do_printf(char *format, ...)
1591{
Bram Moolenaar64404472010-06-26 06:24:45 +02001592 do_intrnl_output(format, 1);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001593}
1594
1595 static void
1596do_flush(void)
1597{
1598 char *buff;
Bram Moolenaar75676462013-01-30 14:55:42 +01001599 OUTPUT_LEN_TYPE length;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001600
Bram Moolenaar75676462013-01-30 14:55:42 +01001601 buff = scheme_get_sized_byte_string_output(curerr, &length);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001602 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001603 if (length)
1604 {
Bram Moolenaar64404472010-06-26 06:24:45 +02001605 do_err_output(buff);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001606 return;
1607 }
1608
Bram Moolenaar75676462013-01-30 14:55:42 +01001609 buff = scheme_get_sized_byte_string_output(curout, &length);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001610 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001611 if (length)
1612 do_output(buff, length);
1613}
1614
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001615/*
1616 *========================================================================
1617 * 4. Implementation of the Vim Features for MzScheme
1618 *========================================================================
1619 */
1620
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001621/*
1622 * (command {command-string})
1623 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001624 static Scheme_Object *
1625vim_command(void *data, int argc, Scheme_Object **argv)
1626{
1627 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar75676462013-01-30 14:55:42 +01001628 Scheme_Object *cmd = NULL;
1629 MZ_GC_DECL_REG(1);
1630 MZ_GC_VAR_IN_REG(0, cmd);
1631 MZ_GC_REG();
1632 cmd = GUARANTEED_STRING_ARG(prim->name, 0);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001633
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001634 // may be use do_cmdline_cmd?
Bram Moolenaar75676462013-01-30 14:55:42 +01001635 do_cmdline(BYTE_STRING_VALUE(cmd), NULL, NULL, DOCMD_NOWAIT|DOCMD_VERBOSE);
Bram Moolenaara4d158b2022-08-14 14:17:45 +01001636 update_screen(UPD_VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001637
Bram Moolenaar75676462013-01-30 14:55:42 +01001638 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001639 raise_if_error();
1640 return scheme_void;
1641}
1642
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001643/*
1644 * (eval {expr-string})
1645 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001646 static Scheme_Object *
Bram Moolenaard2142212013-01-30 17:41:50 +01001647vim_eval(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001648{
1649#ifdef FEAT_EVAL
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001650 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar75676462013-01-30 14:55:42 +01001651 Scheme_Object *result = NULL;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001652 typval_T *vim_result;
Bram Moolenaar75676462013-01-30 14:55:42 +01001653 Scheme_Object *expr = NULL;
1654 MZ_GC_DECL_REG(2);
1655 MZ_GC_VAR_IN_REG(0, result);
1656 MZ_GC_VAR_IN_REG(1, expr);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001657 MZ_GC_REG();
Bram Moolenaar75676462013-01-30 14:55:42 +01001658 expr = GUARANTEED_STRING_ARG(prim->name, 0);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001659
Bram Moolenaar75676462013-01-30 14:55:42 +01001660 vim_result = eval_expr(BYTE_STRING_VALUE(expr), NULL);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001661
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001662 if (vim_result == NULL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001663 raise_vim_exn(_("invalid expression"));
1664
Bram Moolenaar75676462013-01-30 14:55:42 +01001665 result = vim_to_mzscheme(vim_result);
1666 MZ_GC_CHECK();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001667 free_tv(vim_result);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001668
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001669 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001670 return result;
1671#else
1672 raise_vim_exn(_("expressions disabled at compile time"));
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001673 // unreachable
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001674 return scheme_false;
1675#endif
1676}
1677
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001678/*
1679 * (range-start)
1680 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001681 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001682get_range_start(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001683{
1684 return scheme_make_integer(range_start);
1685}
1686
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001687/*
1688 * (range-end)
1689 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001690 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001691get_range_end(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001692{
1693 return scheme_make_integer(range_end);
1694}
1695
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001696/*
1697 * (beep)
1698 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001699 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001700mzscheme_beep(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001701{
Bram Moolenaar165bc692015-07-21 17:53:25 +02001702 vim_beep(BO_LANG);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001703 return scheme_void;
1704}
1705
1706static Scheme_Object *M_global = NULL;
1707
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001708/*
1709 * (get-option {option-name}) [buffer/window]
1710 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001711 static Scheme_Object *
1712get_option(void *data, int argc, Scheme_Object **argv)
1713{
1714 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001715 long value;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001716 char *strval;
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001717 getoption_T rc;
Bram Moolenaar75676462013-01-30 14:55:42 +01001718 Scheme_Object *rval = NULL;
1719 Scheme_Object *name = NULL;
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001720 int scope = 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001721 buf_T *save_curb = curbuf;
1722 win_T *save_curw = curwin;
1723
Bram Moolenaar75676462013-01-30 14:55:42 +01001724 MZ_GC_DECL_REG(2);
1725 MZ_GC_VAR_IN_REG(0, rval);
1726 MZ_GC_VAR_IN_REG(1, name);
1727 MZ_GC_REG();
1728
1729 name = GUARANTEED_STRING_ARG(prim->name, 0);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001730
1731 if (argc > 1)
1732 {
1733 if (M_global == NULL)
1734 {
1735 MZ_REGISTER_STATIC(M_global);
1736 M_global = scheme_intern_symbol("global");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001737 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001738 }
1739
1740 if (argv[1] == M_global)
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001741 scope = OPT_GLOBAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001742 else if (SCHEME_VIMBUFFERP(argv[1]))
1743 {
1744 curbuf = get_valid_buffer(argv[1]);
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001745 scope = OPT_LOCAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001746 }
1747 else if (SCHEME_VIMWINDOWP(argv[1]))
1748 {
1749 win_T *win = get_valid_window(argv[1]);
1750
1751 curwin = win;
1752 curbuf = win->w_buffer;
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001753 scope = OPT_LOCAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001754 }
1755 else
1756 scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv);
1757 }
1758
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001759 rc = get_option_value(BYTE_STRING_VALUE(name), &value, (char_u **)&strval,
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001760 NULL, scope);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001761 curbuf = save_curb;
1762 curwin = save_curw;
1763
1764 switch (rc)
1765 {
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001766 case gov_bool:
1767 case gov_number:
Bram Moolenaar75676462013-01-30 14:55:42 +01001768 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001769 return scheme_make_integer_value(value);
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001770 case gov_string:
Bram Moolenaar75676462013-01-30 14:55:42 +01001771 rval = scheme_make_byte_string(strval);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001772 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001773 vim_free(strval);
Bram Moolenaar75676462013-01-30 14:55:42 +01001774 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001775 return rval;
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001776 case gov_hidden_bool:
1777 case gov_hidden_number:
1778 case gov_hidden_string:
Bram Moolenaar75676462013-01-30 14:55:42 +01001779 MZ_GC_UNREG();
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001780 raise_vim_exn(_("hidden option"));
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001781 //NOTREACHED
Bram Moolenaardd1f4262020-12-31 17:41:01 +01001782 case gov_unknown:
Bram Moolenaar75676462013-01-30 14:55:42 +01001783 MZ_GC_UNREG();
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001784 raise_vim_exn(_("unknown option"));
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001785 //NOTREACHED
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001786 }
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001787 // unreachable
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001788 return scheme_void;
1789}
1790
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001791/*
1792 * (set-option {option-changing-string} [buffer/window])
1793 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001794 static Scheme_Object *
1795set_option(void *data, int argc, Scheme_Object **argv)
1796{
Bram Moolenaar75676462013-01-30 14:55:42 +01001797 char_u *command = NULL;
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001798 int scope = 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001799 buf_T *save_curb = curbuf;
1800 win_T *save_curw = curwin;
1801 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar75676462013-01-30 14:55:42 +01001802 Scheme_Object *cmd = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001803
Bram Moolenaar75676462013-01-30 14:55:42 +01001804 MZ_GC_DECL_REG(1);
1805 MZ_GC_VAR_IN_REG(0, cmd);
1806 MZ_GC_REG();
1807 cmd = GUARANTEED_STRING_ARG(prim->name, 0);
1808
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001809 if (argc > 1)
1810 {
1811 if (M_global == NULL)
1812 {
1813 MZ_REGISTER_STATIC(M_global);
1814 M_global = scheme_intern_symbol("global");
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001815 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001816 }
1817
1818 if (argv[1] == M_global)
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001819 scope = OPT_GLOBAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001820 else if (SCHEME_VIMBUFFERP(argv[1]))
1821 {
1822 curbuf = get_valid_buffer(argv[1]);
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001823 scope = OPT_LOCAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001824 }
1825 else if (SCHEME_VIMWINDOWP(argv[1]))
1826 {
1827 win_T *win = get_valid_window(argv[1]);
1828 curwin = win;
1829 curbuf = win->w_buffer;
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001830 scope = OPT_LOCAL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001831 }
1832 else
1833 scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv);
1834 }
1835
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001836 // do_set can modify cmd, make copy
Bram Moolenaar75676462013-01-30 14:55:42 +01001837 command = vim_strsave(BYTE_STRING_VALUE(cmd));
1838 MZ_GC_UNREG();
Yegappan Lakshmanan64095532021-12-06 11:03:55 +00001839 do_set(command, scope);
Bram Moolenaar75676462013-01-30 14:55:42 +01001840 vim_free(command);
Bram Moolenaara4d158b2022-08-14 14:17:45 +01001841 update_screen(UPD_NOT_VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001842 curbuf = save_curb;
1843 curwin = save_curw;
1844 raise_if_error();
1845 return scheme_void;
1846}
1847
1848/*
1849 *===========================================================================
1850 * 5. Vim Window-related Manipulation Functions
1851 *===========================================================================
1852 */
1853
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001854/*
1855 * (curr-win)
1856 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001857 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001858get_curr_win(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001859{
1860 return (Scheme_Object *)get_vim_curr_window();
1861}
1862
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001863/*
1864 * (win-count)
1865 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001866 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02001867get_window_count(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001868{
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001869 int n = 0;
Bram Moolenaard2142212013-01-30 17:41:50 +01001870 win_T *w;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001871
Bram Moolenaar29323592016-07-24 22:04:11 +02001872 FOR_ALL_WINDOWS(w)
Bram Moolenaarf740b292006-02-16 22:11:02 +00001873 ++n;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001874 return scheme_make_integer(n);
1875}
1876
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001877/*
1878 * (get-win-list [buffer])
1879 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001880 static Scheme_Object *
1881get_window_list(void *data, int argc, Scheme_Object **argv)
1882{
1883 Vim_Prim *prim = (Vim_Prim *)data;
1884 vim_mz_buffer *buf;
1885 Scheme_Object *list;
Bram Moolenaard2142212013-01-30 17:41:50 +01001886 win_T *w = firstwin;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001887
1888 buf = get_buffer_arg(prim->name, 0, argc, argv);
1889 list = scheme_null;
1890
Bram Moolenaard2142212013-01-30 17:41:50 +01001891 for ( ; w != NULL; w = w->w_next)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00001892 if (w->w_buffer == buf->buf)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001893 {
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001894 list = scheme_make_pair(window_new(w), list);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001895 MZ_GC_CHECK();
1896 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001897
1898 return list;
1899}
1900
1901 static Scheme_Object *
1902window_new(win_T *win)
1903{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001904 vim_mz_window *self = NULL;
1905
1906 MZ_GC_DECL_REG(1);
1907 MZ_GC_VAR_IN_REG(0, self);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001908
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001909 // We need to handle deletion of windows underneath us.
1910 // If we add a "w_mzscheme_ref" field to the win_T structure,
1911 // then we can get at it in win_free() in vim.
1912 //
1913 // On a win_free() we set the Scheme object's win_T *field
1914 // to an invalid value. We trap all uses of a window
1915 // object, and reject them if the win_T *field is invalid.
Bram Moolenaare344bea2005-09-01 20:46:49 +00001916 if (win->w_mzscheme_ref != NULL)
Bram Moolenaar75676462013-01-30 14:55:42 +01001917 return (Scheme_Object *)WINDOW_REF(win);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001918
Bram Moolenaar75676462013-01-30 14:55:42 +01001919 MZ_GC_REG();
1920 self = scheme_malloc_fail_ok(scheme_malloc_tagged, sizeof(vim_mz_window));
Bram Moolenaara80faa82020-04-12 19:37:17 +02001921 CLEAR_POINTER(self);
Bram Moolenaar75676462013-01-30 14:55:42 +01001922#ifndef MZ_PRECISE_GC
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001923 scheme_dont_gc_ptr(self); // because win isn't visible to GC
Bram Moolenaar75676462013-01-30 14:55:42 +01001924#else
1925 win->w_mzscheme_ref = scheme_malloc_immobile_box(NULL);
1926#endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001927 MZ_GC_CHECK();
Bram Moolenaar75676462013-01-30 14:55:42 +01001928 WINDOW_REF(win) = self;
1929 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001930 self->win = win;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001931 self->so.type = mz_window_type;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001932
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00001933 MZ_GC_UNREG();
Bram Moolenaar75676462013-01-30 14:55:42 +01001934 return (Scheme_Object *)self;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001935}
1936
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001937/*
1938 * (get-win-num [window])
1939 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001940 static Scheme_Object *
Bram Moolenaard2142212013-01-30 17:41:50 +01001941get_window_num(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001942{
Bram Moolenaard2142212013-01-30 17:41:50 +01001943 int nr = 1;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001944 Vim_Prim *prim = (Vim_Prim *)data;
1945 win_T *win = get_window_arg(prim->name, 0, argc, argv)->win;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001946 win_T *wp;
1947
1948 for (wp = firstwin; wp != win; wp = wp->w_next)
1949 ++nr;
1950
1951 return scheme_make_integer(nr);
1952}
1953
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001954/*
1955 * (get-win-by-num {windownum})
1956 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001957 static Scheme_Object *
1958get_window_by_num(void *data, int argc, Scheme_Object **argv)
1959{
1960 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaard2142212013-01-30 17:41:50 +01001961 win_T *win = firstwin;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001962 int fnum;
1963
1964 fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1965 if (fnum < 1)
1966 scheme_signal_error(_("window index is out of range"));
1967
Bram Moolenaard2142212013-01-30 17:41:50 +01001968 for ( ; win != NULL; win = win->w_next, --fnum)
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001969 if (fnum == 1) // to be 1-based
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001970 return window_new(win);
1971
1972 return scheme_false;
1973}
1974
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001975/*
1976 * (get-win-buffer [window])
1977 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001978 static Scheme_Object *
1979get_window_buffer(void *data, int argc, Scheme_Object **argv)
1980{
1981 Vim_Prim *prim = (Vim_Prim *)data;
1982 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
1983
1984 return buffer_new(win->win->w_buffer);
1985}
1986
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001987/*
1988 * (get-win-height [window])
1989 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00001990 static Scheme_Object *
1991get_window_height(void *data, int argc, Scheme_Object **argv)
1992{
1993 Vim_Prim *prim = (Vim_Prim *)data;
1994 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
1995
1996 return scheme_make_integer(win->win->w_height);
1997}
1998
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01001999/*
2000 * (set-win-height {height} [window])
2001 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002002 static Scheme_Object *
2003set_window_height(void *data, int argc, Scheme_Object **argv)
2004{
2005 Vim_Prim *prim = (Vim_Prim *)data;
2006 vim_mz_window *win;
2007 win_T *savewin;
2008 int height;
2009
2010 win = get_window_arg(prim->name, 1, argc, argv);
2011 height = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2012
2013#ifdef FEAT_GUI
2014 need_mouse_correct = TRUE;
2015#endif
2016
2017 savewin = curwin;
2018 curwin = win->win;
2019 win_setheight(height);
2020 curwin = savewin;
2021
2022 raise_if_error();
2023 return scheme_void;
2024}
2025
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002026/*
2027 * (get-win-width [window])
2028 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002029 static Scheme_Object *
2030get_window_width(void *data, int argc, Scheme_Object **argv)
2031{
2032 Vim_Prim *prim = (Vim_Prim *)data;
2033 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
2034
Bram Moolenaar02631462017-09-22 15:20:32 +02002035 return scheme_make_integer(win->win->w_width);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002036}
2037
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002038/*
2039 * (set-win-width {width} [window])
2040 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002041 static Scheme_Object *
2042set_window_width(void *data, int argc, Scheme_Object **argv)
2043{
2044 Vim_Prim *prim = (Vim_Prim *)data;
2045 vim_mz_window *win;
2046 win_T *savewin;
2047 int width = 0;
2048
2049 win = get_window_arg(prim->name, 1, argc, argv);
2050 width = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2051
2052# ifdef FEAT_GUI
2053 need_mouse_correct = TRUE;
2054# endif
2055
2056 savewin = curwin;
2057 curwin = win->win;
2058 win_setwidth(width);
2059 curwin = savewin;
2060
2061 raise_if_error();
2062 return scheme_void;
2063}
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002064
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002065/*
2066 * (get-cursor [window]) -> (line . col)
2067 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002068 static Scheme_Object *
2069get_cursor(void *data, int argc, Scheme_Object **argv)
2070{
2071 Vim_Prim *prim = (Vim_Prim *)data;
2072 vim_mz_window *win;
2073 pos_T pos;
2074
2075 win = get_window_arg(prim->name, 0, argc, argv);
2076 pos = win->win->w_cursor;
2077 return scheme_make_pair(scheme_make_integer_value((long)pos.lnum),
2078 scheme_make_integer_value((long)pos.col + 1));
2079}
2080
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002081/*
2082 * (set-cursor (line . col) [window])
2083 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002084 static Scheme_Object *
2085set_cursor(void *data, int argc, Scheme_Object **argv)
2086{
2087 Vim_Prim *prim = (Vim_Prim *)data;
2088 vim_mz_window *win;
2089 long lnum = 0;
2090 long col = 0;
2091
Bram Moolenaar555b2802005-05-19 21:08:39 +00002092#ifdef HAVE_SANDBOX
2093 sandbox_check();
2094#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002095 win = get_window_arg(prim->name, 1, argc, argv);
2096 GUARANTEE_PAIR(prim->name, 0);
2097
2098 if (!SCHEME_INTP(SCHEME_CAR(argv[0]))
2099 || !SCHEME_INTP(SCHEME_CDR(argv[0])))
2100 scheme_wrong_type(prim->name, "integer pair", 0, argc, argv);
2101
2102 lnum = SCHEME_INT_VAL(SCHEME_CAR(argv[0]));
2103 col = SCHEME_INT_VAL(SCHEME_CDR(argv[0])) - 1;
2104
2105 check_line_range(lnum, win->win->w_buffer);
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002106 // don't know how to catch invalid column value
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002107
2108 win->win->w_cursor.lnum = lnum;
2109 win->win->w_cursor.col = col;
Bram Moolenaar53901442018-07-25 22:02:36 +02002110 win->win->w_set_curswant = TRUE;
Bram Moolenaara4d158b2022-08-14 14:17:45 +01002111 update_screen(UPD_VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002112
2113 raise_if_error();
2114 return scheme_void;
2115}
2116/*
2117 *===========================================================================
2118 * 6. Vim Buffer-related Manipulation Functions
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002119 *===========================================================================
2120 */
2121
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002122/*
2123 * (open-buff {filename})
2124 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002125 static Scheme_Object *
2126mzscheme_open_buffer(void *data, int argc, Scheme_Object **argv)
2127{
2128 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002129 int num = 0;
Bram Moolenaar75676462013-01-30 14:55:42 +01002130 Scheme_Object *onum = NULL;
2131 Scheme_Object *buf = NULL;
2132 Scheme_Object *fname;
2133
2134 MZ_GC_DECL_REG(3);
2135 MZ_GC_VAR_IN_REG(0, onum);
2136 MZ_GC_VAR_IN_REG(1, buf);
2137 MZ_GC_VAR_IN_REG(2, fname);
2138 MZ_GC_REG();
2139 fname = GUARANTEED_STRING_ARG(prim->name, 0);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002140
Bram Moolenaar555b2802005-05-19 21:08:39 +00002141#ifdef HAVE_SANDBOX
2142 sandbox_check();
2143#endif
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002144 // TODO make open existing file
Bram Moolenaar75676462013-01-30 14:55:42 +01002145 num = buflist_add(BYTE_STRING_VALUE(fname), BLN_LISTED | BLN_CURBUF);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002146
2147 if (num == 0)
2148 raise_vim_exn(_("couldn't open buffer"));
2149
2150 onum = scheme_make_integer(num);
Bram Moolenaar75676462013-01-30 14:55:42 +01002151 buf = get_buffer_by_num(data, 1, &onum);
2152 MZ_GC_UNREG();
2153 return buf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002154}
2155
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002156/*
2157 * (get-buff-by-num {buffernum})
2158 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002159 static Scheme_Object *
2160get_buffer_by_num(void *data, int argc, Scheme_Object **argv)
2161{
2162 Vim_Prim *prim = (Vim_Prim *)data;
2163 buf_T *buf;
2164 int fnum;
2165
2166 fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2167
Bram Moolenaar29323592016-07-24 22:04:11 +02002168 FOR_ALL_BUFFERS(buf)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002169 if (buf->b_fnum == fnum)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002170 return buffer_new(buf);
2171
2172 return scheme_false;
2173}
2174
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002175/*
2176 * (get-buff-by-name {buffername})
2177 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002178 static Scheme_Object *
2179get_buffer_by_name(void *data, int argc, Scheme_Object **argv)
2180{
2181 Vim_Prim *prim = (Vim_Prim *)data;
2182 buf_T *buf;
Bram Moolenaar75676462013-01-30 14:55:42 +01002183 Scheme_Object *buffer = NULL;
2184 Scheme_Object *fname = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002185
Bram Moolenaar75676462013-01-30 14:55:42 +01002186 MZ_GC_DECL_REG(2);
2187 MZ_GC_VAR_IN_REG(0, buffer);
2188 MZ_GC_VAR_IN_REG(1, fname);
2189 MZ_GC_REG();
2190 fname = GUARANTEED_STRING_ARG(prim->name, 0);
2191 buffer = scheme_false;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002192
Bram Moolenaar29323592016-07-24 22:04:11 +02002193 FOR_ALL_BUFFERS(buf)
Bram Moolenaar75676462013-01-30 14:55:42 +01002194 {
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002195 if (buf->b_ffname == NULL || buf->b_sfname == NULL)
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002196 // empty string
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002197 {
Bram Moolenaar75676462013-01-30 14:55:42 +01002198 if (BYTE_STRING_VALUE(fname)[0] == NUL)
2199 buffer = buffer_new(buf);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002200 }
Bram Moolenaar75676462013-01-30 14:55:42 +01002201 else if (!fnamecmp(buf->b_ffname, BYTE_STRING_VALUE(fname))
2202 || !fnamecmp(buf->b_sfname, BYTE_STRING_VALUE(fname)))
2203 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002204 // either short or long filename matches
Bram Moolenaar75676462013-01-30 14:55:42 +01002205 buffer = buffer_new(buf);
2206 }
2207 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002208
Bram Moolenaar75676462013-01-30 14:55:42 +01002209 MZ_GC_UNREG();
2210 return buffer;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002211}
2212
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002213/*
2214 * (get-next-buff [buffer])
2215 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002216 static Scheme_Object *
2217get_next_buffer(void *data, int argc, Scheme_Object **argv)
2218{
2219 Vim_Prim *prim = (Vim_Prim *)data;
2220 buf_T *buf = get_buffer_arg(prim->name, 0, argc, argv)->buf;
2221
2222 if (buf->b_next == NULL)
2223 return scheme_false;
2224 else
2225 return buffer_new(buf->b_next);
2226}
2227
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002228/*
2229 * (get-prev-buff [buffer])
2230 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002231 static Scheme_Object *
2232get_prev_buffer(void *data, int argc, Scheme_Object **argv)
2233{
2234 Vim_Prim *prim = (Vim_Prim *)data;
2235 buf_T *buf = get_buffer_arg(prim->name, 0, argc, argv)->buf;
2236
2237 if (buf->b_prev == NULL)
2238 return scheme_false;
2239 else
2240 return buffer_new(buf->b_prev);
2241}
2242
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002243/*
2244 * (get-buff-num [buffer])
2245 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002246 static Scheme_Object *
2247get_buffer_num(void *data, int argc, Scheme_Object **argv)
2248{
2249 Vim_Prim *prim = (Vim_Prim *)data;
2250 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
2251
2252 return scheme_make_integer(buf->buf->b_fnum);
2253}
2254
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002255/*
2256 * (buff-count)
2257 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002258 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002259get_buffer_count(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002260{
2261 buf_T *b;
2262 int n = 0;
2263
Bram Moolenaar29323592016-07-24 22:04:11 +02002264 FOR_ALL_BUFFERS(b) ++n;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002265 return scheme_make_integer(n);
2266}
2267
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002268/*
2269 * (get-buff-name [buffer])
2270 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002271 static Scheme_Object *
2272get_buffer_name(void *data, int argc, Scheme_Object **argv)
2273{
2274 Vim_Prim *prim = (Vim_Prim *)data;
2275 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
2276
Bram Moolenaar75676462013-01-30 14:55:42 +01002277 return scheme_make_byte_string((char *)buf->buf->b_ffname);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002278}
2279
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002280/*
2281 * (curr-buff)
2282 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002283 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002284get_curr_buffer(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002285{
2286 return (Scheme_Object *)get_vim_curr_buffer();
2287}
2288
2289 static Scheme_Object *
2290buffer_new(buf_T *buf)
2291{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002292 vim_mz_buffer *self = NULL;
2293
2294 MZ_GC_DECL_REG(1);
2295 MZ_GC_VAR_IN_REG(0, self);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002296
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002297 // We need to handle deletion of buffers underneath us.
2298 // If we add a "b_mzscheme_ref" field to the buf_T structure,
2299 // then we can get at it in buf_freeall() in vim.
Bram Moolenaare344bea2005-09-01 20:46:49 +00002300 if (buf->b_mzscheme_ref)
Bram Moolenaar75676462013-01-30 14:55:42 +01002301 return (Scheme_Object *)BUFFER_REF(buf);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002302
Bram Moolenaar75676462013-01-30 14:55:42 +01002303 MZ_GC_REG();
2304 self = scheme_malloc_fail_ok(scheme_malloc_tagged, sizeof(vim_mz_buffer));
Bram Moolenaara80faa82020-04-12 19:37:17 +02002305 CLEAR_POINTER(self);
Bram Moolenaar75676462013-01-30 14:55:42 +01002306#ifndef MZ_PRECISE_GC
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002307 scheme_dont_gc_ptr(self); // because buf isn't visible to GC
Bram Moolenaar75676462013-01-30 14:55:42 +01002308#else
2309 buf->b_mzscheme_ref = scheme_malloc_immobile_box(NULL);
2310#endif
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002311 MZ_GC_CHECK();
Bram Moolenaar75676462013-01-30 14:55:42 +01002312 BUFFER_REF(buf) = self;
2313 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002314 self->buf = buf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002315 self->so.type = mz_buffer_type;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002316
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002317 MZ_GC_UNREG();
Bram Moolenaar75676462013-01-30 14:55:42 +01002318 return (Scheme_Object *)self;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002319}
2320
2321/*
2322 * (get-buff-size [buffer])
2323 *
2324 * Get the size (number of lines) in the current buffer.
2325 */
2326 static Scheme_Object *
2327get_buffer_size(void *data, int argc, Scheme_Object **argv)
2328{
2329 Vim_Prim *prim = (Vim_Prim *)data;
2330 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
2331
2332 return scheme_make_integer(buf->buf->b_ml.ml_line_count);
2333}
2334
2335/*
2336 * (get-buff-line {linenr} [buffer])
2337 *
2338 * Get a line from the specified buffer. The line number is
2339 * in Vim format (1-based). The line is returned as a MzScheme
2340 * string object.
2341 */
2342 static Scheme_Object *
2343get_buffer_line(void *data, int argc, Scheme_Object **argv)
2344{
2345 Vim_Prim *prim = (Vim_Prim *)data;
2346 vim_mz_buffer *buf;
2347 int linenr;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002348 char_u *line;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002349
2350 buf = get_buffer_arg(prim->name, 1, argc, argv);
2351 linenr = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2352 line = ml_get_buf(buf->buf, (linenr_T)linenr, FALSE);
2353
2354 raise_if_error();
Bram Moolenaar75676462013-01-30 14:55:42 +01002355 return scheme_make_byte_string((char *)line);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002356}
2357
2358
2359/*
2360 * (get-buff-line-list {start} {end} [buffer])
2361 *
2362 * Get a list of lines from the specified buffer. The line numbers
2363 * are in Vim format (1-based). The range is from lo up to, but not
2364 * including, hi. The list is returned as a list of string objects.
2365 */
2366 static Scheme_Object *
2367get_buffer_line_list(void *data, int argc, Scheme_Object **argv)
2368{
2369 Vim_Prim *prim = (Vim_Prim *)data;
2370 vim_mz_buffer *buf;
2371 int i, hi, lo, n;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002372 Scheme_Object *list = NULL;
2373
2374 MZ_GC_DECL_REG(1);
2375 MZ_GC_VAR_IN_REG(0, list);
2376 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002377
2378 buf = get_buffer_arg(prim->name, 2, argc, argv);
2379 list = scheme_null;
2380 hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1));
2381 lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2382
2383 /*
2384 * Handle some error conditions
2385 */
2386 if (lo < 0)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002387 lo = 0;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002388
2389 if (hi < 0)
2390 hi = 0;
2391 if (hi < lo)
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002392 hi = lo;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002393
2394 n = hi - lo;
2395
2396 for (i = n; i >= 0; --i)
2397 {
Bram Moolenaar75676462013-01-30 14:55:42 +01002398 Scheme_Object *str = scheme_make_byte_string(
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002399 (char *)ml_get_buf(buf->buf, (linenr_T)(lo+i), FALSE));
2400 raise_if_error();
2401
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002402 // Set the list item
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002403 list = scheme_make_pair(str, list);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002404 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002405 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002406 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002407 return list;
2408}
2409
2410/*
2411 * (set-buff-line {linenr} {string/#f} [buffer])
2412 *
2413 * Replace a line in the specified buffer. The line number is
2414 * in Vim format (1-based). The replacement line is given as
2415 * an MzScheme string object. The object is checked for validity
2416 * and correct format. An exception is thrown if the values are not
2417 * the correct format.
2418 *
2419 * It returns a Scheme Object that indicates the length of the
2420 * string changed.
2421 */
2422 static Scheme_Object *
2423set_buffer_line(void *data, int argc, Scheme_Object **argv)
2424{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002425 // First of all, we check the value of the supplied MzScheme object.
2426 // There are three cases:
2427 // 1. #f - this is a deletion.
2428 // 2. A string - this is a replacement.
2429 // 3. Anything else - this is an error.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002430 Vim_Prim *prim = (Vim_Prim *)data;
2431 vim_mz_buffer *buf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002432 Scheme_Object *line = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002433 char *save;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002434 int n;
2435
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002436 MZ_GC_DECL_REG(1);
2437 MZ_GC_VAR_IN_REG(0, line);
2438 MZ_GC_REG();
2439
Bram Moolenaar555b2802005-05-19 21:08:39 +00002440#ifdef HAVE_SANDBOX
2441 sandbox_check();
2442#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002443 n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2444 if (!SCHEME_STRINGP(argv[1]) && !SCHEME_FALSEP(argv[1]))
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002445 scheme_wrong_type(prim->name, "string or #f", 1, argc, argv);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002446 line = argv[1];
2447 buf = get_buffer_arg(prim->name, 2, argc, argv);
2448
2449 check_line_range(n, buf->buf);
2450
2451 if (SCHEME_FALSEP(line))
2452 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002453 buf_T *savebuf = curbuf;
2454
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002455 curbuf = buf->buf;
2456
2457 if (u_savedel((linenr_T)n, 1L) == FAIL)
2458 {
2459 curbuf = savebuf;
2460 raise_vim_exn(_("cannot save undo information"));
2461 }
Bram Moolenaarca70c072020-05-30 20:30:46 +02002462 else if (ml_delete((linenr_T)n) == FAIL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002463 {
2464 curbuf = savebuf;
2465 raise_vim_exn(_("cannot delete line"));
2466 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002467 if (buf->buf == curwin->w_buffer)
2468 mz_fix_cursor(n, n + 1, -1);
Bram Moolenaarcdcaa582009-07-09 18:06:49 +00002469 deleted_lines_mark((linenr_T)n, 1L);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002470
2471 curbuf = savebuf;
2472
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002473 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002474 raise_if_error();
2475 return scheme_void;
2476 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002477 else
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002478 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002479 // Otherwise it's a line
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002480 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002481
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002482 save = string_to_line(line);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002483
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002484 curbuf = buf->buf;
2485
2486 if (u_savesub((linenr_T)n) == FAIL)
2487 {
2488 curbuf = savebuf;
2489 vim_free(save);
2490 raise_vim_exn(_("cannot save undo information"));
2491 }
2492 else if (ml_replace((linenr_T)n, (char_u *)save, TRUE) == FAIL)
2493 {
2494 curbuf = savebuf;
2495 vim_free(save);
2496 raise_vim_exn(_("cannot replace line"));
2497 }
2498 else
2499 {
2500 vim_free(save);
2501 changed_bytes((linenr_T)n, 0);
2502 }
2503
2504 curbuf = savebuf;
2505
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002506 // Check that the cursor is not beyond the end of the line now.
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002507 if (buf->buf == curwin->w_buffer)
2508 check_cursor_col();
2509
2510 MZ_GC_UNREG();
2511 raise_if_error();
2512 return scheme_void;
2513 }
2514}
2515
2516 static void
2517free_array(char **array)
2518{
2519 char **curr = array;
2520 while (*curr != NULL)
2521 vim_free(*curr++);
2522 vim_free(array);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002523}
2524
2525/*
2526 * (set-buff-line-list {start} {end} {string-list/#f/null} [buffer])
2527 *
2528 * Replace a range of lines in the specified buffer. The line numbers are in
2529 * Vim format (1-based). The range is from lo up to, but not including, hi.
2530 * The replacement lines are given as a Scheme list of string objects. The
2531 * list is checked for validity and correct format.
2532 *
2533 * Errors are returned as a value of FAIL. The return value is OK on success.
2534 * If OK is returned and len_change is not NULL, *len_change is set to the
2535 * change in the buffer length.
2536 */
2537 static Scheme_Object *
2538set_buffer_line_list(void *data, int argc, Scheme_Object **argv)
2539{
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002540 // First of all, we check the type of the supplied MzScheme object.
2541 // There are three cases:
2542 // 1. #f - this is a deletion.
2543 // 2. A list - this is a replacement.
2544 // 3. Anything else - this is an error.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002545 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002546 vim_mz_buffer *buf = NULL;
2547 Scheme_Object *line_list = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002548 int i, old_len, new_len, hi, lo;
2549 long extra;
2550
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002551 MZ_GC_DECL_REG(1);
2552 MZ_GC_VAR_IN_REG(0, line_list);
2553 MZ_GC_REG();
2554
Bram Moolenaar555b2802005-05-19 21:08:39 +00002555#ifdef HAVE_SANDBOX
2556 sandbox_check();
2557#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002558 lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2559 hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1));
2560 if (!SCHEME_PAIRP(argv[2])
2561 && !SCHEME_FALSEP(argv[2]) && !SCHEME_NULLP(argv[2]))
2562 scheme_wrong_type(prim->name, "list or #f", 2, argc, argv);
2563 line_list = argv[2];
2564 buf = get_buffer_arg(prim->name, 3, argc, argv);
2565 old_len = hi - lo;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002566 if (old_len < 0) // process inverse values wisely
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002567 {
2568 i = lo;
2569 lo = hi;
2570 hi = i;
2571 old_len = -old_len;
2572 }
2573 extra = 0;
2574
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002575 check_line_range(lo, buf->buf); // inclusive
2576 check_line_range(hi - 1, buf->buf); // exclusive
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002577
2578 if (SCHEME_FALSEP(line_list) || SCHEME_NULLP(line_list))
2579 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002580 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002581 curbuf = buf->buf;
2582
2583 if (u_savedel((linenr_T)lo, (long)old_len) == FAIL)
2584 {
2585 curbuf = savebuf;
2586 raise_vim_exn(_("cannot save undo information"));
2587 }
2588 else
2589 {
2590 for (i = 0; i < old_len; i++)
Bram Moolenaarca70c072020-05-30 20:30:46 +02002591 if (ml_delete((linenr_T)lo) == FAIL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002592 {
2593 curbuf = savebuf;
2594 raise_vim_exn(_("cannot delete line"));
2595 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002596 if (buf->buf == curwin->w_buffer)
2597 mz_fix_cursor(lo, hi, -old_len);
Bram Moolenaarcdcaa582009-07-09 18:06:49 +00002598 deleted_lines_mark((linenr_T)lo, (long)old_len);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002599 }
2600
2601 curbuf = savebuf;
2602
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002603 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002604 raise_if_error();
2605 return scheme_void;
2606 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002607 else
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002608 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002609 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002610
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002611 // List
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002612 new_len = scheme_proper_list_length(line_list);
2613 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002614 if (new_len < 0) // improper or cyclic list
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002615 scheme_wrong_type(prim->name, "proper list",
2616 2, argc, argv);
2617 else
2618 {
2619 char **array = NULL;
2620 Scheme_Object *line = NULL;
2621 Scheme_Object *rest = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002622
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002623 MZ_GC_DECL_REG(2);
2624 MZ_GC_VAR_IN_REG(0, line);
2625 MZ_GC_VAR_IN_REG(1, rest);
2626 MZ_GC_REG();
2627
Bram Moolenaara80faa82020-04-12 19:37:17 +02002628 array = ALLOC_CLEAR_MULT(char *, new_len + 1);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002629
2630 rest = line_list;
2631 for (i = 0; i < new_len; ++i)
2632 {
2633 line = SCHEME_CAR(rest);
2634 rest = SCHEME_CDR(rest);
2635 if (!SCHEME_STRINGP(line))
2636 {
2637 free_array(array);
2638 scheme_wrong_type(prim->name, "string-list", 2, argc, argv);
2639 }
2640 array[i] = string_to_line(line);
2641 }
2642
2643 curbuf = buf->buf;
2644
2645 if (u_save((linenr_T)(lo-1), (linenr_T)hi) == FAIL)
2646 {
2647 curbuf = savebuf;
2648 free_array(array);
2649 raise_vim_exn(_("cannot save undo information"));
2650 }
2651
2652 /*
2653 * If the size of the range is reducing (ie, new_len < old_len) we
2654 * need to delete some old_len. We do this at the start, by
2655 * repeatedly deleting line "lo".
2656 */
2657 for (i = 0; i < old_len - new_len; ++i)
2658 {
Bram Moolenaarca70c072020-05-30 20:30:46 +02002659 if (ml_delete((linenr_T)lo) == FAIL)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002660 {
2661 curbuf = savebuf;
2662 free_array(array);
2663 raise_vim_exn(_("cannot delete line"));
2664 }
2665 extra--;
2666 }
2667
2668 /*
2669 * For as long as possible, replace the existing old_len with the
2670 * new old_len. This is a more efficient operation, as it requires
2671 * less memory allocation and freeing.
2672 */
2673 for (i = 0; i < old_len && i < new_len; i++)
2674 if (ml_replace((linenr_T)(lo+i), (char_u *)array[i], TRUE) == FAIL)
2675 {
2676 curbuf = savebuf;
2677 free_array(array);
2678 raise_vim_exn(_("cannot replace line"));
2679 }
2680
2681 /*
2682 * Now we may need to insert the remaining new_len. We don't need to
2683 * free the string passed back because MzScheme has control of that
2684 * memory.
2685 */
2686 while (i < new_len)
2687 {
2688 if (ml_append((linenr_T)(lo + i - 1),
2689 (char_u *)array[i], 0, FALSE) == FAIL)
2690 {
2691 curbuf = savebuf;
2692 free_array(array);
2693 raise_vim_exn(_("cannot insert line"));
2694 }
2695 ++i;
2696 ++extra;
2697 }
2698 MZ_GC_UNREG();
2699 free_array(array);
2700 }
2701
2702 /*
2703 * Adjust marks. Invalidate any which lie in the
2704 * changed range, and move any in the remainder of the buffer.
2705 */
Bram Moolenaarfd89d7e2016-06-04 20:25:05 +02002706 mark_adjust((linenr_T)lo, (linenr_T)(hi - 1),
2707 (long)MAXLNUM, (long)extra);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002708 changed_lines((linenr_T)lo, 0, (linenr_T)hi, (long)extra);
2709
2710 if (buf->buf == curwin->w_buffer)
2711 mz_fix_cursor(lo, hi, extra);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002712 curbuf = savebuf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002713
2714 MZ_GC_UNREG();
2715 raise_if_error();
2716 return scheme_void;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002717 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002718}
2719
2720/*
2721 * (insert-buff-line-list {linenr} {string/string-list} [buffer])
2722 *
Bram Moolenaar0a1c0ec2009-12-16 18:02:47 +00002723 * Insert a number of lines into the specified buffer after the specified line.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002724 * The line number is in Vim format (1-based). The lines to be inserted are
2725 * given as an MzScheme list of string objects or as a single string. The lines
2726 * to be added are checked for validity and correct format. Errors are
2727 * returned as a value of FAIL. The return value is OK on success.
2728 * If OK is returned and len_change is not NULL, *len_change
2729 * is set to the change in the buffer length.
2730 */
2731 static Scheme_Object *
2732insert_buffer_line_list(void *data, int argc, Scheme_Object **argv)
2733{
2734 Vim_Prim *prim = (Vim_Prim *)data;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002735 vim_mz_buffer *buf = NULL;
2736 Scheme_Object *list = NULL;
2737 char *str = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002738 int i, n, size;
2739
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002740 MZ_GC_DECL_REG(1);
2741 MZ_GC_VAR_IN_REG(0, list);
2742 MZ_GC_REG();
2743
Bram Moolenaar555b2802005-05-19 21:08:39 +00002744#ifdef HAVE_SANDBOX
2745 sandbox_check();
2746#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002747 /*
2748 * First of all, we check the type of the supplied MzScheme object.
2749 * It must be a string or a list, or the call is in error.
2750 */
2751 n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
2752 list = argv[1];
2753
2754 if (!SCHEME_STRINGP(list) && !SCHEME_PAIRP(list))
2755 scheme_wrong_type(prim->name, "string or list", 1, argc, argv);
2756 buf = get_buffer_arg(prim->name, 2, argc, argv);
2757
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002758 if (n != 0) // 0 can be used in insert
Bram Moolenaarc9b4b052006-04-30 18:54:39 +00002759 check_line_range(n, buf->buf);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002760 if (SCHEME_STRINGP(list))
2761 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002762 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002763
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002764 str = string_to_line(list);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002765 curbuf = buf->buf;
2766
2767 if (u_save((linenr_T)n, (linenr_T)(n+1)) == FAIL)
2768 {
2769 curbuf = savebuf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002770 vim_free(str);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002771 raise_vim_exn(_("cannot save undo information"));
2772 }
2773 else if (ml_append((linenr_T)n, (char_u *)str, 0, FALSE) == FAIL)
2774 {
2775 curbuf = savebuf;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002776 vim_free(str);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002777 raise_vim_exn(_("cannot insert line"));
2778 }
2779 else
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002780 {
2781 vim_free(str);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002782 appended_lines_mark((linenr_T)n, 1L);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002783 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002784
2785 curbuf = savebuf;
Bram Moolenaara4d158b2022-08-14 14:17:45 +01002786 update_screen(UPD_VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002787
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002788 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002789 raise_if_error();
2790 return scheme_void;
2791 }
2792
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002793 // List
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002794 size = scheme_proper_list_length(list);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002795 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002796 if (size < 0) // improper or cyclic list
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002797 scheme_wrong_type(prim->name, "proper list",
2798 2, argc, argv);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002799 else
2800 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002801 Scheme_Object *line = NULL;
2802 Scheme_Object *rest = NULL;
2803 char **array;
2804 buf_T *savebuf = curbuf;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002805
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002806 MZ_GC_DECL_REG(2);
2807 MZ_GC_VAR_IN_REG(0, line);
2808 MZ_GC_VAR_IN_REG(1, rest);
2809 MZ_GC_REG();
2810
Bram Moolenaara80faa82020-04-12 19:37:17 +02002811 array = ALLOC_CLEAR_MULT(char *, size + 1);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002812
2813 rest = list;
2814 for (i = 0; i < size; ++i)
2815 {
2816 line = SCHEME_CAR(rest);
2817 rest = SCHEME_CDR(rest);
2818 array[i] = string_to_line(line);
2819 }
2820
2821 curbuf = buf->buf;
2822
2823 if (u_save((linenr_T)n, (linenr_T)(n + 1)) == FAIL)
2824 {
2825 curbuf = savebuf;
2826 free_array(array);
2827 raise_vim_exn(_("cannot save undo information"));
2828 }
2829 else
2830 {
2831 for (i = 0; i < size; ++i)
2832 if (ml_append((linenr_T)(n + i), (char_u *)array[i],
2833 0, FALSE) == FAIL)
2834 {
2835 curbuf = savebuf;
2836 free_array(array);
2837 raise_vim_exn(_("cannot insert line"));
2838 }
2839
2840 if (i > 0)
2841 appended_lines_mark((linenr_T)n, (long)i);
2842 }
2843 free_array(array);
2844 MZ_GC_UNREG();
2845 curbuf = savebuf;
Bram Moolenaara4d158b2022-08-14 14:17:45 +01002846 update_screen(UPD_VALID);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002847 }
2848
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002849 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002850 raise_if_error();
2851 return scheme_void;
2852}
2853
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002854/*
2855 * Predicates
2856 */
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002857/*
2858 * (buff? obj)
2859 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002860 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002861vim_bufferp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002862{
2863 if (SCHEME_VIMBUFFERP(argv[0]))
2864 return scheme_true;
2865 else
2866 return scheme_false;
2867}
2868
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002869/*
2870 * (win? obj)
2871 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002872 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002873vim_windowp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002874{
2875 if (SCHEME_VIMWINDOWP(argv[0]))
2876 return scheme_true;
2877 else
2878 return scheme_false;
2879}
2880
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002881/*
2882 * (buff-valid? obj)
2883 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002884 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002885vim_buffer_validp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002886{
2887 if (SCHEME_VIMBUFFERP(argv[0])
2888 && ((vim_mz_buffer *)argv[0])->buf != INVALID_BUFFER_VALUE)
2889 return scheme_true;
2890 else
2891 return scheme_false;
2892}
2893
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002894/*
2895 * (win-valid? obj)
2896 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002897 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02002898vim_window_validp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002899{
2900 if (SCHEME_VIMWINDOWP(argv[0])
2901 && ((vim_mz_window *)argv[0])->win != INVALID_WINDOW_VALUE)
2902 return scheme_true;
2903 else
2904 return scheme_false;
2905}
2906
2907/*
2908 *===========================================================================
2909 * Utilities
2910 *===========================================================================
2911 */
2912
2913/*
2914 * Convert an MzScheme string into a Vim line.
2915 *
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002916 * All internal nulls are replaced by newline characters.
2917 * It is an error for the string to contain newline characters.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002918 *
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002919 * Returns pointer to Vim allocated memory
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002920 */
2921 static char *
2922string_to_line(Scheme_Object *obj)
2923{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002924 char *scheme_str = NULL;
2925 char *vim_str = NULL;
Bram Moolenaar75676462013-01-30 14:55:42 +01002926 OUTPUT_LEN_TYPE len;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002927 int i;
2928
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002929 scheme_str = scheme_display_to_string(obj, &len);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002930
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002931 // Error checking: String must not contain newlines, as we
2932 // are replacing a single line, and we must replace it with
2933 // a single line.
Bram Moolenaar75676462013-01-30 14:55:42 +01002934 if (memchr(scheme_str, '\n', len))
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002935 scheme_signal_error(_("string cannot contain newlines"));
2936
Bram Moolenaarc799fe22019-05-28 23:08:19 +02002937 vim_str = alloc(len + 1);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002938
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002939 // Create a copy of the string, with internal nulls replaced by
2940 // newline characters, as is the vim convention.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002941 for (i = 0; i < len; ++i)
2942 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002943 if (scheme_str[i] == '\0')
2944 vim_str[i] = '\n';
2945 else
2946 vim_str[i] = scheme_str[i];
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002947 }
2948
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002949 vim_str[i] = '\0';
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002950
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002951 MZ_GC_CHECK();
2952 return vim_str;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00002953}
2954
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002955#ifdef FEAT_EVAL
2956/*
2957 * Convert Vim value into MzScheme, adopted from if_python.c
2958 */
2959 static Scheme_Object *
Bram Moolenaar75676462013-01-30 14:55:42 +01002960vim_to_mzscheme(typval_T *vim_value)
2961{
2962 Scheme_Object *result = NULL;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002963 // hash table to store visited values to avoid infinite loops
Bram Moolenaar75676462013-01-30 14:55:42 +01002964 Scheme_Hash_Table *visited = NULL;
2965
2966 MZ_GC_DECL_REG(2);
2967 MZ_GC_VAR_IN_REG(0, result);
2968 MZ_GC_VAR_IN_REG(1, visited);
2969 MZ_GC_REG();
2970
2971 visited = scheme_make_hash_table(SCHEME_hash_ptr);
2972 MZ_GC_CHECK();
2973
2974 result = vim_to_mzscheme_impl(vim_value, 1, visited);
2975
2976 MZ_GC_UNREG();
2977 return result;
2978}
2979
2980 static Scheme_Object *
2981vim_to_mzscheme_impl(typval_T *vim_value, int depth, Scheme_Hash_Table *visited)
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002982{
2983 Scheme_Object *result = NULL;
2984 int new_value = TRUE;
2985
Bram Moolenaar75676462013-01-30 14:55:42 +01002986 MZ_GC_DECL_REG(2);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002987 MZ_GC_VAR_IN_REG(0, result);
Bram Moolenaar75676462013-01-30 14:55:42 +01002988 MZ_GC_VAR_IN_REG(1, visited);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002989 MZ_GC_REG();
2990
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002991 // Avoid infinite recursion
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00002992 if (depth > 100)
2993 {
2994 MZ_GC_UNREG();
2995 return scheme_void;
2996 }
2997
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01002998 // Check if we run into a recursive loop. The item must be in visited
2999 // then and we can use it again.
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003000 result = scheme_hash_get(visited, (Scheme_Object *)vim_value);
3001 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003002 if (result != NULL) // found, do nothing
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003003 new_value = FALSE;
3004 else if (vim_value->v_type == VAR_STRING)
3005 {
Bram Moolenaar75676462013-01-30 14:55:42 +01003006 result = scheme_make_byte_string((char *)vim_value->vval.v_string);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003007 MZ_GC_CHECK();
3008 }
3009 else if (vim_value->v_type == VAR_NUMBER)
3010 {
3011 result = scheme_make_integer((long)vim_value->vval.v_number);
3012 MZ_GC_CHECK();
3013 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003014 else if (vim_value->v_type == VAR_FLOAT)
3015 {
3016 result = scheme_make_double((double)vim_value->vval.v_float);
3017 MZ_GC_CHECK();
3018 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003019 else if (vim_value->v_type == VAR_LIST)
3020 {
3021 list_T *list = vim_value->vval.v_list;
3022 listitem_T *curr;
3023
3024 if (list == NULL || list->lv_first == NULL)
3025 result = scheme_null;
3026 else
3027 {
3028 Scheme_Object *obj = NULL;
3029
3030 MZ_GC_DECL_REG(1);
3031 MZ_GC_VAR_IN_REG(0, obj);
3032 MZ_GC_REG();
3033
Bram Moolenaar0ff6aad2020-01-29 21:27:21 +01003034 curr = list->lv_u.mat.lv_last;
Bram Moolenaar75676462013-01-30 14:55:42 +01003035 obj = vim_to_mzscheme_impl(&curr->li_tv, depth + 1, visited);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003036 result = scheme_make_pair(obj, scheme_null);
3037 MZ_GC_CHECK();
3038
3039 while (curr != list->lv_first)
3040 {
3041 curr = curr->li_prev;
Bram Moolenaar75676462013-01-30 14:55:42 +01003042 obj = vim_to_mzscheme_impl(&curr->li_tv, depth + 1, visited);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003043 result = scheme_make_pair(obj, result);
3044 MZ_GC_CHECK();
3045 }
3046 }
3047 MZ_GC_UNREG();
3048 }
3049 else if (vim_value->v_type == VAR_DICT)
3050 {
3051 Scheme_Object *key = NULL;
3052 Scheme_Object *obj = NULL;
3053
3054 MZ_GC_DECL_REG(2);
3055 MZ_GC_VAR_IN_REG(0, key);
3056 MZ_GC_VAR_IN_REG(1, obj);
3057 MZ_GC_REG();
3058
3059 result = (Scheme_Object *)scheme_make_hash_table(SCHEME_hash_ptr);
3060 MZ_GC_CHECK();
3061 if (vim_value->vval.v_dict != NULL)
3062 {
3063 hashtab_T *ht = &vim_value->vval.v_dict->dv_hashtab;
3064 long_u todo = ht->ht_used;
3065 hashitem_T *hi;
3066 dictitem_T *di;
3067
3068 for (hi = ht->ht_array; todo > 0; ++hi)
3069 {
3070 if (!HASHITEM_EMPTY(hi))
3071 {
3072 --todo;
3073
3074 di = dict_lookup(hi);
Bram Moolenaar75676462013-01-30 14:55:42 +01003075 obj = vim_to_mzscheme_impl(&di->di_tv, depth + 1, visited);
3076 key = scheme_make_byte_string((char *)hi->hi_key);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003077 MZ_GC_CHECK();
3078 scheme_hash_set((Scheme_Hash_Table *)result, key, obj);
3079 MZ_GC_CHECK();
3080 }
3081 }
3082 }
3083 MZ_GC_UNREG();
3084 }
Bram Moolenaar75676462013-01-30 14:55:42 +01003085 else if (vim_value->v_type == VAR_FUNC)
3086 {
3087 Scheme_Object *funcname = NULL;
3088
3089 MZ_GC_DECL_REG(1);
3090 MZ_GC_VAR_IN_REG(0, funcname);
3091 MZ_GC_REG();
3092
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003093 // FIXME: func_ref() and func_unref() are needed.
Bram Moolenaar75676462013-01-30 14:55:42 +01003094 funcname = scheme_make_byte_string((char *)vim_value->vval.v_string);
3095 MZ_GC_CHECK();
3096 result = scheme_make_closed_prim_w_arity(vim_funcref, funcname,
3097 (const char *)BYTE_STRING_VALUE(funcname), 0, -1);
3098 MZ_GC_CHECK();
3099
3100 MZ_GC_UNREG();
3101 }
Bram Moolenaar67c2c052016-03-30 22:03:02 +02003102 else if (vim_value->v_type == VAR_PARTIAL)
3103 {
3104 if (vim_value->vval.v_partial == NULL)
3105 result = scheme_null;
3106 else
3107 {
3108 Scheme_Object *funcname = NULL;
3109
3110 MZ_GC_DECL_REG(1);
3111 MZ_GC_VAR_IN_REG(0, funcname);
3112 MZ_GC_REG();
3113
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003114 // FIXME: func_ref() and func_unref() are needed.
3115 // TODO: Support pt_dict and pt_argv.
Bram Moolenaar67c2c052016-03-30 22:03:02 +02003116 funcname = scheme_make_byte_string(
Bram Moolenaar437bafe2016-08-01 15:40:54 +02003117 (char *)partial_name(vim_value->vval.v_partial));
Bram Moolenaar67c2c052016-03-30 22:03:02 +02003118 MZ_GC_CHECK();
3119 result = scheme_make_closed_prim_w_arity(vim_funcref, funcname,
3120 (const char *)BYTE_STRING_VALUE(funcname), 0, -1);
3121 MZ_GC_CHECK();
3122
3123 MZ_GC_UNREG();
3124 }
3125 }
Bram Moolenaar9b4a15d2020-01-11 16:05:23 +01003126 else if (vim_value->v_type == VAR_BOOL || vim_value->v_type == VAR_SPECIAL)
Bram Moolenaar520e1e42016-01-23 19:46:28 +01003127 {
3128 if (vim_value->vval.v_number <= VVAL_TRUE)
3129 result = scheme_make_integer((long)vim_value->vval.v_number);
3130 else
3131 result = scheme_null;
3132 MZ_GC_CHECK();
3133 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003134 else
3135 {
3136 result = scheme_void;
3137 new_value = FALSE;
3138 }
3139 if (new_value)
3140 {
3141 scheme_hash_set(visited, (Scheme_Object *)vim_value, result);
3142 MZ_GC_CHECK();
3143 }
3144 MZ_GC_UNREG();
3145 return result;
3146}
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003147
3148 static int
Bram Moolenaar75676462013-01-30 14:55:42 +01003149mzscheme_to_vim(Scheme_Object *obj, typval_T *tv)
3150{
3151 int i, status;
3152 Scheme_Hash_Table *visited = NULL;
3153
3154 MZ_GC_DECL_REG(2);
3155 MZ_GC_VAR_IN_REG(0, obj);
3156 MZ_GC_VAR_IN_REG(1, visited);
3157 MZ_GC_REG();
3158
3159 visited = scheme_make_hash_table(SCHEME_hash_ptr);
3160 MZ_GC_CHECK();
3161
3162 status = mzscheme_to_vim_impl(obj, tv, 1, visited);
3163 for (i = 0; i < visited->size; ++i)
3164 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003165 // free up remembered objects
Bram Moolenaar75676462013-01-30 14:55:42 +01003166 if (visited->vals[i] != NULL)
3167 free_tv((typval_T *)visited->vals[i]);
3168 }
3169
3170 MZ_GC_UNREG();
3171 return status;
3172}
3173 static int
3174mzscheme_to_vim_impl(Scheme_Object *obj, typval_T *tv, int depth,
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003175 Scheme_Hash_Table *visited)
3176{
3177 int status = OK;
3178 typval_T *found;
Bram Moolenaar75676462013-01-30 14:55:42 +01003179
3180 MZ_GC_DECL_REG(2);
3181 MZ_GC_VAR_IN_REG(0, obj);
3182 MZ_GC_VAR_IN_REG(1, visited);
3183 MZ_GC_REG();
3184
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003185 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003186 if (depth > 100) // limit the deepest recursion level
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003187 {
3188 tv->v_type = VAR_NUMBER;
3189 tv->vval.v_number = 0;
3190 return FAIL;
3191 }
3192
3193 found = (typval_T *)scheme_hash_get(visited, obj);
3194 if (found != NULL)
3195 copy_tv(found, tv);
3196 else if (SCHEME_VOIDP(obj))
3197 {
Bram Moolenaar520e1e42016-01-23 19:46:28 +01003198 tv->v_type = VAR_SPECIAL;
3199 tv->vval.v_number = VVAL_NULL;
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003200 }
3201 else if (SCHEME_INTP(obj))
3202 {
3203 tv->v_type = VAR_NUMBER;
3204 tv->vval.v_number = SCHEME_INT_VAL(obj);
3205 }
3206 else if (SCHEME_BOOLP(obj))
3207 {
Bram Moolenaar9b4a15d2020-01-11 16:05:23 +01003208 tv->v_type = VAR_BOOL;
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003209 tv->vval.v_number = SCHEME_TRUEP(obj);
3210 }
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003211 else if (SCHEME_DBLP(obj))
3212 {
3213 tv->v_type = VAR_FLOAT;
3214 tv->vval.v_float = SCHEME_DBL_VAL(obj);
3215 }
Bram Moolenaar75676462013-01-30 14:55:42 +01003216 else if (SCHEME_BYTE_STRINGP(obj))
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003217 {
3218 tv->v_type = VAR_STRING;
Bram Moolenaar75676462013-01-30 14:55:42 +01003219 tv->vval.v_string = vim_strsave(BYTE_STRING_VALUE(obj));
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003220 }
Bram Moolenaar75676462013-01-30 14:55:42 +01003221# if MZSCHEME_VERSION_MAJOR >= 299
3222 else if (SCHEME_CHAR_STRINGP(obj))
3223 {
3224 Scheme_Object *tmp = NULL;
3225 MZ_GC_DECL_REG(1);
3226 MZ_GC_VAR_IN_REG(0, tmp);
3227 MZ_GC_REG();
3228
3229 tmp = scheme_char_string_to_byte_string(obj);
3230 tv->v_type = VAR_STRING;
3231 tv->vval.v_string = vim_strsave(BYTE_STRING_VALUE(tmp));
3232 MZ_GC_UNREG();
3233 }
3234#endif
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003235 else if (SCHEME_VECTORP(obj) || SCHEME_NULLP(obj)
3236 || SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj))
3237 {
3238 list_T *list = list_alloc();
3239 if (list == NULL)
3240 status = FAIL;
3241 else
3242 {
3243 int i;
3244 Scheme_Object *curr = NULL;
3245 Scheme_Object *cval = NULL;
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003246 // temporary var to hold current element of vectors and pairs
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003247 typval_T *v;
3248
3249 MZ_GC_DECL_REG(2);
3250 MZ_GC_VAR_IN_REG(0, curr);
3251 MZ_GC_VAR_IN_REG(1, cval);
3252 MZ_GC_REG();
3253
3254 tv->v_type = VAR_LIST;
3255 tv->vval.v_list = list;
3256 ++list->lv_refcount;
3257
Bram Moolenaarc799fe22019-05-28 23:08:19 +02003258 v = ALLOC_ONE(typval_T);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003259 if (v == NULL)
3260 status = FAIL;
3261 else
3262 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003263 // add the value in advance to allow handling of self-referential
3264 // data structures
Bram Moolenaarc799fe22019-05-28 23:08:19 +02003265 typval_T *visited_tv = ALLOC_ONE(typval_T);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003266 copy_tv(tv, visited_tv);
3267 scheme_hash_set(visited, obj, (Scheme_Object *)visited_tv);
3268
3269 if (SCHEME_VECTORP(obj))
3270 {
3271 for (i = 0; i < SCHEME_VEC_SIZE(obj); ++i)
3272 {
3273 cval = SCHEME_VEC_ELS(obj)[i];
Bram Moolenaar75676462013-01-30 14:55:42 +01003274 status = mzscheme_to_vim_impl(cval, v, depth + 1, visited);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003275 if (status == FAIL)
3276 break;
3277 status = list_append_tv(list, v);
3278 clear_tv(v);
3279 if (status == FAIL)
3280 break;
3281 }
3282 }
3283 else if (SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj))
3284 {
3285 for (curr = obj;
3286 SCHEME_PAIRP(curr) || SCHEME_MUTABLE_PAIRP(curr);
3287 curr = SCHEME_CDR(curr))
3288 {
3289 cval = SCHEME_CAR(curr);
Bram Moolenaar75676462013-01-30 14:55:42 +01003290 status = mzscheme_to_vim_impl(cval, v, depth + 1, visited);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003291 if (status == FAIL)
3292 break;
3293 status = list_append_tv(list, v);
3294 clear_tv(v);
3295 if (status == FAIL)
3296 break;
3297 }
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003298 // improper list not terminated with null
3299 // need to handle the last element
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003300 if (status == OK && !SCHEME_NULLP(curr))
3301 {
Bram Moolenaar75676462013-01-30 14:55:42 +01003302 status = mzscheme_to_vim_impl(cval, v, depth + 1, visited);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003303 if (status == OK)
3304 {
3305 status = list_append_tv(list, v);
3306 clear_tv(v);
3307 }
3308 }
3309 }
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003310 // nothing to do for scheme_null
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003311 vim_free(v);
3312 }
3313 MZ_GC_UNREG();
3314 }
3315 }
3316 else if (SCHEME_HASHTP(obj))
3317 {
3318 int i;
3319 dict_T *dict;
3320 Scheme_Object *key = NULL;
3321 Scheme_Object *val = NULL;
3322
3323 MZ_GC_DECL_REG(2);
3324 MZ_GC_VAR_IN_REG(0, key);
3325 MZ_GC_VAR_IN_REG(1, val);
3326 MZ_GC_REG();
3327
3328 dict = dict_alloc();
3329 if (dict == NULL)
3330 status = FAIL;
3331 else
3332 {
Bram Moolenaarc799fe22019-05-28 23:08:19 +02003333 typval_T *visited_tv = ALLOC_ONE(typval_T);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003334
3335 tv->v_type = VAR_DICT;
3336 tv->vval.v_dict = dict;
3337 ++dict->dv_refcount;
3338
3339 copy_tv(tv, visited_tv);
3340 scheme_hash_set(visited, obj, (Scheme_Object *)visited_tv);
3341
3342 for (i = 0; i < ((Scheme_Hash_Table *)obj)->size; ++i)
3343 {
3344 if (((Scheme_Hash_Table *) obj)->vals[i] != NULL)
3345 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003346 // generate item for `display'ed Scheme key
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003347 dictitem_T *item = dictitem_alloc((char_u *)string_to_line(
3348 ((Scheme_Hash_Table *) obj)->keys[i]));
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003349 // convert Scheme val to Vim and add it to the dict
Bram Moolenaar75676462013-01-30 14:55:42 +01003350 if (mzscheme_to_vim_impl(((Scheme_Hash_Table *) obj)->vals[i],
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003351 &item->di_tv, depth + 1, visited) == FAIL
3352 || dict_add(dict, item) == FAIL)
3353 {
3354 dictitem_free(item);
3355 status = FAIL;
3356 break;
3357 }
3358 }
3359
3360 }
3361 }
3362 MZ_GC_UNREG();
3363 }
3364 else
3365 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003366 // `display' any other value to string
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003367 tv->v_type = VAR_STRING;
3368 tv->vval.v_string = (char_u *)string_to_line(obj);
3369 }
Bram Moolenaar75676462013-01-30 14:55:42 +01003370 MZ_GC_UNREG();
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003371 return status;
3372}
3373
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003374/*
3375 * Scheme prim procedure wrapping Vim funcref
3376 */
Bram Moolenaar75676462013-01-30 14:55:42 +01003377 static Scheme_Object *
3378vim_funcref(void *name, int argc, Scheme_Object **argv)
3379{
3380 int i;
3381 typval_T args;
3382 int status = OK;
3383 Scheme_Object *result = NULL;
3384 list_T *list = list_alloc();
3385
3386 MZ_GC_DECL_REG(1);
3387 MZ_GC_VAR_IN_REG(0, result);
3388 MZ_GC_REG();
3389
3390 result = scheme_void;
3391 if (list == NULL)
3392 status = FAIL;
3393 else
3394 {
3395 args.v_type = VAR_LIST;
3396 args.vval.v_list = list;
3397 ++list->lv_refcount;
3398 for (i = 0; status == OK && i < argc; ++i)
3399 {
Bram Moolenaarc799fe22019-05-28 23:08:19 +02003400 typval_T *v = ALLOC_ONE(typval_T);
Bram Moolenaar75676462013-01-30 14:55:42 +01003401 if (v == NULL)
3402 status = FAIL;
3403 else
3404 {
3405 status = mzscheme_to_vim(argv[i], v);
3406 if (status == OK)
3407 {
3408 status = list_append_tv(list, v);
3409 clear_tv(v);
3410 }
3411 vim_free(v);
3412 }
3413 }
3414 if (status == OK)
3415 {
3416 typval_T ret;
3417 ret.v_type = VAR_UNKNOWN;
3418
3419 mzscheme_call_vim(BYTE_STRING_VALUE((Scheme_Object *)name), &args, &ret);
3420 MZ_GC_CHECK();
3421 result = vim_to_mzscheme(&ret);
3422 clear_tv(&ret);
3423 MZ_GC_CHECK();
3424 }
3425 }
3426 clear_tv(&args);
3427 MZ_GC_UNREG();
3428 if (status != OK)
3429 raise_vim_exn(_("error converting Scheme values to Vim"));
3430 else
3431 raise_if_error();
3432 return result;
3433}
3434
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003435 void
3436do_mzeval(char_u *str, typval_T *rettv)
3437{
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003438 Scheme_Object *ret = NULL;
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003439
Bram Moolenaar75676462013-01-30 14:55:42 +01003440 MZ_GC_DECL_REG(1);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003441 MZ_GC_VAR_IN_REG(0, ret);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003442 MZ_GC_REG();
3443
3444 if (mzscheme_init())
3445 {
3446 MZ_GC_UNREG();
3447 return;
3448 }
3449
3450 MZ_GC_CHECK();
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003451 if (eval_with_exn_handling(str, do_eval, &ret) == OK)
Bram Moolenaar75676462013-01-30 14:55:42 +01003452 mzscheme_to_vim(ret, rettv);
Bram Moolenaar7e506b62010-01-19 15:55:06 +01003453
3454 MZ_GC_UNREG();
3455}
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003456#endif
3457
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003458/*
3459 * Check to see whether a Vim error has been reported, or a keyboard
3460 * interrupt (from vim --> got_int) has been detected.
3461 */
3462 static int
3463vim_error_check(void)
3464{
3465 return (got_int || did_emsg);
3466}
3467
3468/*
3469 * register Scheme exn:vim
3470 */
3471 static void
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003472register_vim_exn(void)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003473{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003474 int nc = 0;
3475 int i;
3476 Scheme_Object *struct_exn = NULL;
3477 Scheme_Object *exn_name = NULL;
3478
3479 MZ_GC_DECL_REG(2);
3480 MZ_GC_VAR_IN_REG(0, struct_exn);
3481 MZ_GC_VAR_IN_REG(1, exn_name);
3482 MZ_GC_REG();
3483
3484 exn_name = scheme_intern_symbol("exn:vim");
3485 MZ_GC_CHECK();
3486 struct_exn = scheme_builtin_value("struct:exn");
3487 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003488
3489 if (vim_exn == NULL)
3490 vim_exn = scheme_make_struct_type(exn_name,
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003491 struct_exn, NULL, 0, 0, NULL, NULL
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003492#if MZSCHEME_VERSION_MAJOR >= 299
3493 , NULL
3494#endif
3495 );
3496
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003497
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003498 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003499 Scheme_Object **tmp = NULL;
3500 Scheme_Object *exn_names[5] = {NULL, NULL, NULL, NULL, NULL};
3501 Scheme_Object *exn_values[5] = {NULL, NULL, NULL, NULL, NULL};
3502 MZ_GC_DECL_REG(6);
3503 MZ_GC_ARRAY_VAR_IN_REG(0, exn_names, 5);
3504 MZ_GC_ARRAY_VAR_IN_REG(3, exn_values, 5);
3505 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003506
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003507 tmp = scheme_make_struct_names(exn_name, scheme_null, 0, &nc);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003508 mch_memmove(exn_names, tmp, nc * sizeof(Scheme_Object *));
3509 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003510
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003511 tmp = scheme_make_struct_values(vim_exn, exn_names, nc, 0);
3512 mch_memmove(exn_values, tmp, nc * sizeof(Scheme_Object *));
3513 MZ_GC_CHECK();
3514
3515 for (i = 0; i < nc; i++)
3516 {
3517 scheme_add_global_symbol(exn_names[i],
3518 exn_values[i], environment);
3519 MZ_GC_CHECK();
3520 }
3521 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003522 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003523 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003524}
3525
3526/*
3527 * raise exn:vim, may be with additional info string
3528 */
3529 void
3530raise_vim_exn(const char *add_info)
3531{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003532 char *fmt = _("Vim error: ~a");
3533 Scheme_Object *argv[2] = {NULL, NULL};
3534 Scheme_Object *exn = NULL;
Bram Moolenaar75676462013-01-30 14:55:42 +01003535 Scheme_Object *byte_string = NULL;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003536
Bram Moolenaar75676462013-01-30 14:55:42 +01003537 MZ_GC_DECL_REG(5);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003538 MZ_GC_ARRAY_VAR_IN_REG(0, argv, 2);
3539 MZ_GC_VAR_IN_REG(3, exn);
Bram Moolenaar75676462013-01-30 14:55:42 +01003540 MZ_GC_VAR_IN_REG(4, byte_string);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003541 MZ_GC_REG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003542
3543 if (add_info != NULL)
3544 {
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003545 char *c_string = NULL;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003546 Scheme_Object *info = NULL;
3547
3548 MZ_GC_DECL_REG(3);
3549 MZ_GC_VAR_IN_REG(0, c_string);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003550 MZ_GC_VAR_IN_REG(2, info);
3551 MZ_GC_REG();
3552
Bram Moolenaar75676462013-01-30 14:55:42 +01003553 info = scheme_make_byte_string(add_info);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003554 MZ_GC_CHECK();
Bram Moolenaar9b0ac222016-06-01 20:31:43 +02003555 c_string = scheme_format_utf8(fmt, (int)STRLEN(fmt), 1, &info, NULL);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003556 MZ_GC_CHECK();
Bram Moolenaar75676462013-01-30 14:55:42 +01003557 byte_string = scheme_make_byte_string(c_string);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003558 MZ_GC_CHECK();
3559 argv[0] = scheme_byte_string_to_char_string(byte_string);
Bram Moolenaar555b2802005-05-19 21:08:39 +00003560 SCHEME_SET_IMMUTABLE(argv[0]);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003561 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003562 }
3563 else
Bram Moolenaar75676462013-01-30 14:55:42 +01003564 {
3565 byte_string = scheme_make_byte_string(_("Vim error"));
3566 MZ_GC_CHECK();
3567 argv[0] = scheme_byte_string_to_char_string(byte_string);
3568 MZ_GC_CHECK();
3569 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003570 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003571
Bram Moolenaar049377e2007-05-12 15:32:12 +00003572#if MZSCHEME_VERSION_MAJOR < 360
3573 argv[1] = scheme_current_continuation_marks();
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003574 MZ_GC_CHECK();
Bram Moolenaar049377e2007-05-12 15:32:12 +00003575#else
Bram Moolenaarc81e5e72007-05-05 18:24:42 +00003576 argv[1] = scheme_current_continuation_marks(NULL);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003577 MZ_GC_CHECK();
Bram Moolenaar049377e2007-05-12 15:32:12 +00003578#endif
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003579
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003580 exn = scheme_make_struct_instance(vim_exn, 2, argv);
3581 MZ_GC_CHECK();
3582 scheme_raise(exn);
3583 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003584}
3585
3586 void
3587raise_if_error(void)
3588{
3589 if (vim_error_check())
3590 raise_vim_exn(NULL);
3591}
3592
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003593/*
3594 * get buffer:
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003595 * either current
3596 * or passed as argv[argnum] with checks
3597 */
3598 static vim_mz_buffer *
3599get_buffer_arg(const char *fname, int argnum, int argc, Scheme_Object **argv)
3600{
3601 vim_mz_buffer *b;
3602
3603 if (argc < argnum + 1)
3604 return get_vim_curr_buffer();
3605 if (!SCHEME_VIMBUFFERP(argv[argnum]))
3606 scheme_wrong_type(fname, "vim-buffer", argnum, argc, argv);
3607 b = (vim_mz_buffer *)argv[argnum];
3608 (void)get_valid_buffer(argv[argnum]);
3609 return b;
3610}
3611
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003612/*
3613 * get window:
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003614 * either current
3615 * or passed as argv[argnum] with checks
3616 */
3617 static vim_mz_window *
3618get_window_arg(const char *fname, int argnum, int argc, Scheme_Object **argv)
3619{
3620 vim_mz_window *w;
3621
3622 if (argc < argnum + 1)
3623 return get_vim_curr_window();
3624 w = (vim_mz_window *)argv[argnum];
3625 if (!SCHEME_VIMWINDOWP(argv[argnum]))
3626 scheme_wrong_type(fname, "vim-window", argnum, argc, argv);
3627 (void)get_valid_window(argv[argnum]);
3628 return w;
3629}
3630
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003631/*
3632 * get valid Vim buffer from Scheme_Object*
3633 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003634buf_T *get_valid_buffer(void *obj)
3635{
3636 buf_T *buf = ((vim_mz_buffer *)obj)->buf;
3637
3638 if (buf == INVALID_BUFFER_VALUE)
3639 scheme_signal_error(_("buffer is invalid"));
3640 return buf;
3641}
3642
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003643/*
3644 * get valid Vim window from Scheme_Object*
3645 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003646win_T *get_valid_window(void *obj)
3647{
3648 win_T *win = ((vim_mz_window *)obj)->win;
3649 if (win == INVALID_WINDOW_VALUE)
3650 scheme_signal_error(_("window is invalid"));
3651 return win;
3652}
3653
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003654 int
3655mzthreads_allowed(void)
3656{
3657 return mz_threads_allow;
3658}
3659
3660 static int
3661line_in_range(linenr_T lnum, buf_T *buf)
3662{
3663 return (lnum > 0 && lnum <= buf->b_ml.ml_line_count);
3664}
3665
3666 static void
3667check_line_range(linenr_T lnum, buf_T *buf)
3668{
3669 if (!line_in_range(lnum, buf))
3670 scheme_signal_error(_("linenr out of range"));
3671}
3672
3673/*
3674 * Check if deleting lines made the cursor position invalid
3675 * (or you'll get msg from Vim about invalid linenr).
3676 * Changed the lines from "lo" to "hi" and added "extra" lines (negative if
3677 * deleted). Got from if_python.c
3678 */
3679 static void
3680mz_fix_cursor(int lo, int hi, int extra)
3681{
3682 if (curwin->w_cursor.lnum >= lo)
3683 {
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003684 // Adjust the cursor position if it's in/after the changed
3685 // lines.
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003686 if (curwin->w_cursor.lnum >= hi)
3687 {
3688 curwin->w_cursor.lnum += extra;
3689 check_cursor_col();
3690 }
3691 else if (extra < 0)
3692 {
3693 curwin->w_cursor.lnum = lo;
3694 check_cursor();
3695 }
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003696 else
3697 check_cursor_col();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003698 changed_cline_bef_curs();
3699 }
3700 invalidate_botline();
3701}
3702
3703static Vim_Prim prims[]=
3704{
3705 /*
3706 * Buffer-related commands
3707 */
3708 {get_buffer_line, "get-buff-line", 1, 2},
3709 {set_buffer_line, "set-buff-line", 2, 3},
3710 {get_buffer_line_list, "get-buff-line-list", 2, 3},
3711 {get_buffer_name, "get-buff-name", 0, 1},
3712 {get_buffer_num, "get-buff-num", 0, 1},
3713 {get_buffer_size, "get-buff-size", 0, 1},
3714 {set_buffer_line_list, "set-buff-line-list", 3, 4},
3715 {insert_buffer_line_list, "insert-buff-line-list", 2, 3},
3716 {get_curr_buffer, "curr-buff", 0, 0},
3717 {get_buffer_count, "buff-count", 0, 0},
3718 {get_next_buffer, "get-next-buff", 0, 1},
3719 {get_prev_buffer, "get-prev-buff", 0, 1},
3720 {mzscheme_open_buffer, "open-buff", 1, 1},
3721 {get_buffer_by_name, "get-buff-by-name", 1, 1},
3722 {get_buffer_by_num, "get-buff-by-num", 1, 1},
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003723 /*
3724 * Window-related commands
3725 */
3726 {get_curr_win, "curr-win", 0, 0},
3727 {get_window_count, "win-count", 0, 0},
3728 {get_window_by_num, "get-win-by-num", 1, 1},
3729 {get_window_num, "get-win-num", 0, 1},
3730 {get_window_buffer, "get-win-buffer", 0, 1},
3731 {get_window_height, "get-win-height", 0, 1},
3732 {set_window_height, "set-win-height", 1, 2},
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003733 {get_window_width, "get-win-width", 0, 1},
3734 {set_window_width, "set-win-width", 1, 2},
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003735 {get_cursor, "get-cursor", 0, 1},
3736 {set_cursor, "set-cursor", 1, 2},
3737 {get_window_list, "get-win-list", 0, 1},
3738 /*
3739 * Vim-related commands
3740 */
3741 {vim_command, "command", 1, 1},
3742 {vim_eval, "eval", 1, 1},
3743 {get_range_start, "range-start", 0, 0},
3744 {get_range_end, "range-end", 0, 0},
3745 {mzscheme_beep, "beep", 0, 0},
3746 {get_option, "get-option", 1, 2},
3747 {set_option, "set-option", 1, 2},
3748 /*
3749 * small utilities
3750 */
3751 {vim_bufferp, "buff?", 1, 1},
3752 {vim_windowp, "win?", 1, 1},
3753 {vim_buffer_validp, "buff-valid?", 1, 1},
3754 {vim_window_validp, "win-valid?", 1, 1}
3755};
3756
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003757/*
3758 * return MzScheme wrapper for curbuf
3759 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003760 static vim_mz_buffer *
3761get_vim_curr_buffer(void)
3762{
Bram Moolenaare344bea2005-09-01 20:46:49 +00003763 if (curbuf->b_mzscheme_ref == NULL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003764 return (vim_mz_buffer *)buffer_new(curbuf);
3765 else
Bram Moolenaar75676462013-01-30 14:55:42 +01003766 return BUFFER_REF(curbuf);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003767}
3768
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003769/*
3770 * return MzScheme wrapper for curwin
3771 */
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003772 static vim_mz_window *
3773get_vim_curr_window(void)
3774{
Bram Moolenaare344bea2005-09-01 20:46:49 +00003775 if (curwin->w_mzscheme_ref == NULL)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003776 return (vim_mz_window *)window_new(curwin);
3777 else
Bram Moolenaar75676462013-01-30 14:55:42 +01003778 return WINDOW_REF(curwin);
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003779}
3780
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003781 static void
Bram Moolenaar68c2f632016-01-30 17:24:07 +01003782make_modules(void)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003783{
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003784 int i;
3785 Scheme_Env *mod = NULL;
3786 Scheme_Object *vimext_symbol = NULL;
3787 Scheme_Object *closed_prim = NULL;
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003788
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003789 MZ_GC_DECL_REG(3);
3790 MZ_GC_VAR_IN_REG(0, mod);
3791 MZ_GC_VAR_IN_REG(1, vimext_symbol);
3792 MZ_GC_VAR_IN_REG(2, closed_prim);
3793 MZ_GC_REG();
3794
3795 vimext_symbol = scheme_intern_symbol("vimext");
3796 MZ_GC_CHECK();
3797 mod = scheme_primitive_module(vimext_symbol, environment);
3798 MZ_GC_CHECK();
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003799 // all prims made closed so they can access their own names
K.Takataeeec2542021-06-02 13:28:16 +02003800 for (i = 0; i < (int)ARRAY_LENGTH(prims); i++)
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003801 {
3802 Vim_Prim *prim = prims + i;
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003803 closed_prim = scheme_make_closed_prim_w_arity(prim->prim, prim, prim->name,
3804 prim->mina, prim->maxa);
3805 scheme_add_global(prim->name, closed_prim, mod);
3806 MZ_GC_CHECK();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003807 }
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003808 scheme_finish_primitive_module(mod);
Bram Moolenaar9e70cf12009-05-26 20:59:55 +00003809 MZ_GC_CHECK();
3810 MZ_GC_UNREG();
Bram Moolenaar325b7a22004-07-05 15:58:32 +00003811}
Bram Moolenaard857f0e2005-06-21 22:37:39 +00003812
Bram Moolenaar555b2802005-05-19 21:08:39 +00003813#ifdef HAVE_SANDBOX
3814static Scheme_Object *M_write = NULL;
3815static Scheme_Object *M_read = NULL;
3816static Scheme_Object *M_execute = NULL;
3817static Scheme_Object *M_delete = NULL;
3818
3819 static void
Bram Moolenaarc81e5e72007-05-05 18:24:42 +00003820sandbox_check(void)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003821{
3822 if (sandbox)
3823 raise_vim_exn(_("not allowed in the Vim sandbox"));
3824}
3825
Bram Moolenaar2ab2e862019-12-04 21:24:53 +01003826/*
3827 * security guards to force Vim's sandbox restrictions on MzScheme level
3828 */
Bram Moolenaar555b2802005-05-19 21:08:39 +00003829 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02003830sandbox_file_guard(int argc UNUSED, Scheme_Object **argv)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003831{
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00003832 if (!sandbox)
3833 return scheme_void;
3834
3835 Scheme_Object *requested_access = argv[2];
3836
3837 if (M_write == NULL)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003838 {
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00003839 MZ_REGISTER_STATIC(M_write);
3840 M_write = scheme_intern_symbol("write");
3841 MZ_GC_CHECK();
Bram Moolenaar555b2802005-05-19 21:08:39 +00003842 }
Yegappan Lakshmanan0233bdf2023-01-12 12:33:30 +00003843 if (M_read == NULL)
3844 {
3845 MZ_REGISTER_STATIC(M_read);
3846 M_read = scheme_intern_symbol("read");
3847 MZ_GC_CHECK();
3848 }
3849 if (M_execute == NULL)
3850 {
3851 MZ_REGISTER_STATIC(M_execute);
3852 M_execute = scheme_intern_symbol("execute");
3853 MZ_GC_CHECK();
3854 }
3855 if (M_delete == NULL)
3856 {
3857 MZ_REGISTER_STATIC(M_delete);
3858 M_delete = scheme_intern_symbol("delete");
3859 MZ_GC_CHECK();
3860 }
3861
3862 while (!SCHEME_NULLP(requested_access))
3863 {
3864 Scheme_Object *item = SCHEME_CAR(requested_access);
3865 if (scheme_eq(item, M_write) || scheme_eq(item, M_read)
3866 || scheme_eq(item, M_execute) || scheme_eq(item, M_delete))
3867 raise_vim_exn(_("not allowed in the Vim sandbox"));
3868 requested_access = SCHEME_CDR(requested_access);
3869 }
3870
Bram Moolenaar555b2802005-05-19 21:08:39 +00003871 return scheme_void;
3872}
3873
3874 static Scheme_Object *
Bram Moolenaar64404472010-06-26 06:24:45 +02003875sandbox_network_guard(int argc UNUSED, Scheme_Object **argv UNUSED)
Bram Moolenaar555b2802005-05-19 21:08:39 +00003876{
3877 return scheme_void;
3878}
3879#endif
Bram Moolenaar76b92b22006-03-24 22:46:53 +00003880
3881#endif