Mercurial > vim

comparison src/if_mzsch.c @ 14:946da5994c01

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
updated for version 7.0006
author vimboss
date Mon, 05 Jul 2004 15:58:32 +0000
parents
children 631143ac4a01
comparison
equal deleted inserted replaced
13:24d5189d3956 14:946da5994c01
1 /* vi:set ts=8 sts=4 sw=4:
2 *
3 * MzScheme interface by Sergey Khorev <khorev@softlab.ru>
4 * Original work by Brent Fulgham <bfulgham@debian.org>
5 * (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
20 * to build with SMALL or TINY features but with MzScheme interface.
21 * 3. I don't use K&R-style functions. Anyway, MzScheme headers are ANSI.
22 */
23
24 /* TODO
25 * way to catch Vim errors (incl. verbose messages)
26 * libmzscheme.dll dynamic loading
27 * macros to pass modifiers (e.g. (browse edit))
28 * opportunity to use shared mzscheme libraries on Unix
29 * event on-change-mode
30 * Scheme-driven coloring
31 * global exn-handler
32 * embed Read-Eval-Print-Loop
33 */
34
35 #include "vim.h"
36 #include "if_mzsch.h"
37
38 /* Base data structures */
39 #define SCHEME_VIMBUFFERP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type)
40 #define SCHEME_VIMWINDOWP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_window_type)
41
42 typedef struct
43 {
44 Scheme_Type tag;
45 Scheme_Env *env;
46 buf_T *buf;
47 Scheme_Object *text_objects;
48 } vim_mz_buffer;
49
50 #define INVALID_BUFFER_VALUE ((buf_T *)(-1))
51
52 typedef struct
53 {
54 Scheme_Type tag;
55 struct window *win;
56 } vim_mz_window;
57
58 #define INVALID_WINDOW_VALUE ((win_T *)(-1))
59
60 /*
61 * Prims that form MzScheme Vim interface
62 */
63 typedef struct
64 {
65 Scheme_Closed_Prim *prim;
66 char *name;
67 int mina; /* arity information */
68 int maxa;
69 } Vim_Prim;
70
71 typedef struct
72 {
73 char *name;
74 Scheme_Object *port;
75 } Port_Info;
76
77 /* info for closed prim */
78 /*
79 * data have different means:
80 * for do_eval it is char*
81 * for do_apply is Apply_Onfo*
82 * for do_load is Port_Info*
83 */
84 typedef struct
85 {
86 void *data;
87 Scheme_Env *env;
88 } Cmd_Info;
89
90 /* info for do_apply */
91 typedef struct
92 {
93 Scheme_Object *proc;
94 int argc;
95 Scheme_Object **argv;
96 } Apply_Info;
97
98 /*
99 *========================================================================
100 * Vim-Control Commands
101 *========================================================================
102 */
103 /*
104 *========================================================================
105 * Utility functions for the vim/mzscheme interface
106 *========================================================================
107 */
108 /* Buffer-related commands */
109 static Scheme_Object *buffer_new(buf_T *buf);
110 static Scheme_Object *get_buffer_by_name(void *, int, Scheme_Object **);
111 static Scheme_Object *get_buffer_by_num(void *, int, Scheme_Object **);
112 static Scheme_Object *get_buffer_count(void *, int, Scheme_Object **);
113 static Scheme_Object *get_buffer_line(void *, int, Scheme_Object **);
114 static Scheme_Object *get_buffer_line_list(void *, int, Scheme_Object **);
115 static Scheme_Object *get_buffer_name(void *, int, Scheme_Object **);
116 static Scheme_Object *get_buffer_num(void *, int, Scheme_Object **);
117 static Scheme_Object *get_buffer_size(void *, int, Scheme_Object **);
118 static Scheme_Object *get_curr_buffer(void *, int, Scheme_Object **);
119 static Scheme_Object *get_next_buffer(void *, int, Scheme_Object **);
120 static Scheme_Object *get_prev_buffer(void *, int, Scheme_Object **);
121 static Scheme_Object *mzscheme_open_buffer(void *, int, Scheme_Object **);
122 static Scheme_Object *set_buffer_line(void *, int, Scheme_Object **);
123 static Scheme_Object *set_buffer_line_list(void *, int, Scheme_Object **);
124 static Scheme_Object *insert_buffer_line_list(void *, int, Scheme_Object **);
125 static Scheme_Object *get_range_start(void *, int, Scheme_Object **);
126 static Scheme_Object *get_range_end(void *, int, Scheme_Object **);
127 static Scheme_Object *get_buffer_namespace(void *, int, Scheme_Object **);
128 static vim_mz_buffer *get_vim_curr_buffer(void);
129
130 /* Window-related commands */
131 static Scheme_Object *window_new(win_T *win);
132 static Scheme_Object *get_curr_win(void *, int, Scheme_Object **);
133 static Scheme_Object *get_window_count(void *, int, Scheme_Object **);
134 static Scheme_Object *get_window_by_num(void *, int, Scheme_Object **);
135 static Scheme_Object *get_window_num(void *, int, Scheme_Object **);
136 static Scheme_Object *get_window_buffer(void *, int, Scheme_Object **);
137 static Scheme_Object *get_window_height(void *, int, Scheme_Object **);
138 static Scheme_Object *set_window_height(void *, int, Scheme_Object **);
139 #ifdef FEAT_VERTSPLIT
140 static Scheme_Object *get_window_width(void *, int, Scheme_Object **);
141 static Scheme_Object *set_window_width(void *, int, Scheme_Object **);
142 #endif
143 static Scheme_Object *get_cursor(void *, int, Scheme_Object **);
144 static Scheme_Object *set_cursor(void *, int, Scheme_Object **);
145 static Scheme_Object *get_window_list(void *, int, Scheme_Object **);
146 static vim_mz_window *get_vim_curr_window(void);
147
148 /* Vim-related commands */
149 static Scheme_Object *mzscheme_beep(void *, int, Scheme_Object **);
150 static Scheme_Object *get_option(void *, int, Scheme_Object **);
151 static Scheme_Object *set_option(void *, int, Scheme_Object **);
152 static Scheme_Object *vim_command(void *, int, Scheme_Object **);
153 static Scheme_Object *vim_eval(void *, int, Scheme_Object **);
154 static Scheme_Object *vim_bufferp(void *data, int, Scheme_Object **);
155 static Scheme_Object *vim_windowp(void *data, int, Scheme_Object **);
156 static Scheme_Object *vim_buffer_validp(void *data, int, Scheme_Object **);
157 static Scheme_Object *vim_window_validp(void *data, int, Scheme_Object **);
158
159 /*
160 *========================================================================
161 * Internal Function Prototypes
162 *========================================================================
163 */
164 static int vim_error_check(void);
165 static int do_mzscheme_command(exarg_T *, void *, Scheme_Closed_Prim *what);
166 static void startup_mzscheme(void);
167 static char *string_to_line(Scheme_Object *obj);
168 static int mzscheme_io_init(void);
169 static void mzscheme_interface_init(vim_mz_buffer *self);
170 static void do_output(char *mesg, long len);
171 static void do_printf(char *format, ...);
172 static void do_flush(void);
173 static Scheme_Object *_apply_thunk_catch_exceptions(
174 Scheme_Object *, Scheme_Object **);
175 static Scheme_Object *extract_exn_message(Scheme_Object *v);
176 static Scheme_Object *do_eval(void *, int noargc, Scheme_Object **noargv);
177 static Scheme_Object *do_load(void *, int noargc, Scheme_Object **noargv);
178 static Scheme_Object *do_apply(void *, int noargc, Scheme_Object **noargv);
179 static void register_vim_exn(Scheme_Env *env);
180 static vim_mz_buffer *get_buffer_arg(const char *fname, int argnum,
181 int argc, Scheme_Object **argv);
182 static vim_mz_window *get_window_arg(const char *fname, int argnum,
183 int argc, Scheme_Object **argv);
184 static void add_vim_exn(Scheme_Env *env);
185 static int line_in_range(linenr_T, buf_T *);
186 static void check_line_range(linenr_T, buf_T *);
187 static void mz_fix_cursor(int lo, int hi, int extra);
188
189 static int eval_in_namespace(void *, Scheme_Closed_Prim *, Scheme_Env *,
190 Scheme_Object **ret);
191 static void make_modules(Scheme_Env *);
192
193 /*
194 *========================================================================
195 * 1. MzScheme interpreter startup
196 *========================================================================
197 */
198
199 static Scheme_Type mz_buffer_type;
200 static Scheme_Type mz_window_type;
201
202 static int initialized = 0;
203
204 /* global environment */
205 static Scheme_Env *environment = NULL;
206 /* output/error handlers */
207 static Scheme_Object *curout = NULL;
208 static Scheme_Object *curerr = NULL;
209 /* vim:exn exception */
210 static Scheme_Object *exn_catching_apply = NULL;
211 static Scheme_Object *exn_p = NULL;
212 static Scheme_Object *exn_message = NULL;
213 static Scheme_Object *vim_exn = NULL; /* Vim Error exception */
214 /* values for exn:vim - constructor, predicate, accessors etc */
215 static Scheme_Object *vim_exn_names = NULL;
216 static Scheme_Object *vim_exn_values = NULL;
217
218 static long range_start;
219 static long range_end;
220
221 /* MzScheme threads scheduling stuff */
222 static int mz_threads_allow = 0;
223 #ifdef FEAT_GUI
224 static void setup_timer(void);
225 static void remove_timer(void);
226 #endif
227
228 #if defined(FEAT_GUI_W32)
229 static void CALLBACK timer_proc(HWND, UINT, UINT, DWORD);
230 static UINT timer_id = 0;
231 #elif defined(FEAT_GUI_GTK)
232 static gint timer_proc(gpointer);
233 static guint timer_id = 0;
234 #elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA)
235 static void timer_proc(XtPointer, XtIntervalId *);
236 static XtIntervalId timer_id = (XtIntervalId)0;
237 #elif defined(FEAT_GUI_MAC)
238 pascal void timer_proc(EventLoopTimerRef, void *);
239 static EventLoopTimerRef timer_id = NULL;
240 static EventLoopTimerUPP timerUPP;
241 #endif
242
243 #ifndef FEAT_GUI_W32 /* Win32 console and Unix */
244 void
245 mzvim_check_threads(void)
246 {
247 /* Last time MzScheme threads were scheduled */
248 static time_t mz_last_time = 0;
249
250 if (mz_threads_allow && p_mzq > 0)
251 {
252 time_t now = time(NULL);
253
254 if ((now - mz_last_time) * 1000 > p_mzq)
255 {
256 mz_last_time = now;
257 scheme_check_threads();
258 }
259 }
260 }
261 #endif
262
263 #ifdef FEAT_GUI
264 /* timers are presented in GUI only */
265 # if defined(FEAT_GUI_W32)
266 static void CALLBACK
267 timer_proc(HWND hwnd, UINT uMsg, UINT idEvent, DWORD dwTime)
268 # elif defined(FEAT_GUI_GTK)
269 /*ARGSUSED*/
270 static gint
271 timer_proc(gpointer data)
272 # elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA)
273 /* ARGSUSED */
274 static void
275 timer_proc(XtPointer timed_out, XtIntervalId *interval_id)
276 # elif defined(FEAT_GUI_MAC)
277 pascal void
278 timer_proc(EventLoopTimerRef theTimer, void *userData)
279 # endif
280 {
281 scheme_check_threads();
282 # if defined(FEAT_GUI_GTK)
283 return TRUE; /* continue receiving notifications */
284 # elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA)
285 /* renew timeout */
286 if (mz_threads_allow && p_mzq > 0)
287 timer_id = XtAppAddTimeOut(app_context, p_mzq,
288 timer_proc, NULL);
289 # endif
290 }
291
292 static void
293 setup_timer(void)
294 {
295 # if defined(FEAT_GUI_W32)
296 timer_id = SetTimer(NULL, 0, p_mzq, timer_proc);
297 # elif defined(FEAT_GUI_GTK)
298 timer_id = gtk_timeout_add((guint32)p_mzq, (GtkFunction)timer_proc, NULL);
299 # elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA)
300 timer_id = XtAppAddTimeOut(app_context, p_mzq, timer_proc, NULL);
301 # elif defined(FEAT_GUI_MAC)
302 timerUPP = NewEventLoopTimerUPP(timer_proc);
303 InstallEventLoopTimer(GetMainEventLoop(), p_mzq * kEventDurationMillisecond,
304 p_mzq * kEventDurationMillisecond, timerUPP, NULL, &timer_id);
305 # endif
306 }
307
308 static void
309 remove_timer(void)
310 {
311 # if defined(FEAT_GUI_W32)
312 KillTimer(NULL, timer_id);
313 # elif defined(FEAT_GUI_GTK)
314 gtk_timeout_remove(timer_id);
315 # elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA)
316 XtRemoveTimeOut(timer_id);
317 # elif defined(FEAT_GUI_MAC)
318 RemoveEventLoopTimer(timer_id);
319 DisposeEventLoopTimerUPP(timerUPP);
320 # endif
321 timer_id = 0;
322 }
323
324 void
325 mzvim_reset_timer(void)
326 {
327 if (timer_id != 0)
328 remove_timer();
329 if (mz_threads_allow && p_mzq > 0 && gui.in_use)
330 setup_timer();
331 }
332
333 #endif
334
335 static void
336 notify_multithread(int on)
337 {
338 mz_threads_allow = on;
339 #ifdef FEAT_GUI
340 if (on && timer_id == 0 && p_mzq > 0 && gui.in_use)
341 setup_timer();
342 if (!on && timer_id != 0)
343 remove_timer();
344 #endif
345 }
346
347 int
348 mzscheme_enabled(int verbose)
349 {
350 return initialized;
351 }
352
353 void
354 mzscheme_end(void)
355 {
356 }
357
358 static void
359 startup_mzscheme(void)
360 {
361 scheme_set_stack_base(NULL, 1);
362
363 MZ_REGISTER_STATIC(environment);
364 MZ_REGISTER_STATIC(curout);
365 MZ_REGISTER_STATIC(curerr);
366 MZ_REGISTER_STATIC(exn_catching_apply);
367 MZ_REGISTER_STATIC(exn_p);
368 MZ_REGISTER_STATIC(exn_message);
369 MZ_REGISTER_STATIC(vim_exn);
370 MZ_REGISTER_STATIC(vim_exn_names);
371 MZ_REGISTER_STATIC(vim_exn_values);
372
373 environment = scheme_basic_env();
374
375 /* redirect output */
376 scheme_console_output = do_output;
377 scheme_console_printf = do_printf;
378
379 #ifdef MZSCHEME_COLLECTS
380 /* setup 'current-library-collection-paths' parameter */
381 scheme_set_param(scheme_config, MZCONFIG_COLLECTION_PATHS,
382 scheme_make_pair(scheme_make_string(MZSCHEME_COLLECTS),
383 scheme_null));
384 #endif
385
386 /* Create buffer and window types for use in Scheme code */
387 mz_buffer_type = scheme_make_type("<vim-buffer>");
388 mz_window_type = scheme_make_type("<vim-window>");
389
390 register_vim_exn(environment);
391 make_modules(environment);
392
393 /*
394 * setup callback to receive notifications
395 * whether thread scheduling is (or not) required
396 */
397 scheme_notify_multithread = notify_multithread;
398 initialized = 1;
399 }
400
401 /*
402 * This routine is called for each new invocation of MzScheme
403 * to make sure things are properly initialized.
404 */
405 static int
406 mzscheme_init(void)
407 {
408 int do_require = FALSE;
409
410 if (!initialized)
411 {
412 do_require = TRUE;
413 startup_mzscheme();
414
415 if (mzscheme_io_init())
416 return -1;
417
418 }
419 /* recreate ports each call effectivelly clearing these ones */
420 curout = scheme_make_string_output_port();
421 curerr = scheme_make_string_output_port();
422 scheme_set_param(scheme_config, MZCONFIG_OUTPUT_PORT, curout);
423 scheme_set_param(scheme_config, MZCONFIG_ERROR_PORT, curerr);
424
425 if (do_require)
426 {
427 /* auto-instantiate in basic env */
428 eval_in_namespace("(require (prefix vimext: vimext))", do_eval,
429 environment, NULL);
430 }
431
432 return 0;
433 }
434
435 /*
436 * This routine fills the namespace with various important routines that can
437 * be used within MzScheme.
438 */
439 static void
440 mzscheme_interface_init(vim_mz_buffer *mzbuff)
441 {
442 Scheme_Object *attach;
443
444 mzbuff->env = (Scheme_Env *)scheme_make_namespace(0, NULL);
445
446 /*
447 * attach instantiated modules from global namespace
448 * so they can be easily instantiated in the buffer namespace
449 */
450 attach = scheme_lookup_global(
451 scheme_intern_symbol("namespace-attach-module"),
452 environment);
453
454 if (attach != NULL)
455 {
456 Scheme_Object *ret;
457 Scheme_Object *args[2];
458
459 args[0] = (Scheme_Object *)environment;
460 args[1] = scheme_intern_symbol("vimext");
461
462 ret = (Scheme_Object *)mzvim_apply(attach, 2, args);
463 }
464
465 add_vim_exn(mzbuff->env);
466 }
467
468 /*
469 *========================================================================
470 * 2. External Interface
471 *========================================================================
472 */
473
474 /*
475 * Evaluate command in namespace with exception handling
476 */
477 static int
478 eval_in_namespace(void *data, Scheme_Closed_Prim *what, Scheme_Env *env,
479 Scheme_Object **ret)
480 {
481 Scheme_Object *value;
482 Scheme_Object *exn;
483 Cmd_Info info; /* closure info */
484
485 info.data = data;
486 info.env = env;
487
488 scheme_set_param(scheme_config, MZCONFIG_ENV,
489 (Scheme_Object *) env);
490 /*
491 * ensure all evaluations will be in current buffer namespace,
492 * the second argument to scheme_eval_string isn't enough!
493 */
494 value = _apply_thunk_catch_exceptions(
495 scheme_make_closed_prim_w_arity(what, &info, "mzvim", 0, 0),
496 &exn);
497
498 if (!value)
499 {
500 value = extract_exn_message(exn);
501 /* Got an exn? */
502 if (value)
503 {
504 scheme_display(value, curerr); /* Send to stderr-vim */
505 do_flush();
506 }
507 /* `raise' was called on some arbitrary value */
508 return FAIL;
509 }
510
511 if (ret != NULL) /* if pointer to retval supported give it up */
512 *ret = value;
513 /* Print any result, as long as it's not a void */
514 else if (!SCHEME_VOIDP(value))
515 scheme_display(value, curout); /* Send to stdout-vim */
516
517 do_flush();
518 return OK;
519 }
520
521 /* :mzscheme */
522 static int
523 do_mzscheme_command(exarg_T *eap, void *data, Scheme_Closed_Prim *what)
524 {
525 if (mzscheme_init())
526 return FAIL;
527
528 range_start = eap->line1;
529 range_end = eap->line2;
530
531 return eval_in_namespace(data, what, get_vim_curr_buffer()->env, NULL);
532 }
533
534 /*
535 * Routine called by VIM when deleting a buffer
536 */
537 void
538 mzscheme_buffer_free(buf_T *buf)
539 {
540 if (buf->mzscheme_ref)
541 {
542 vim_mz_buffer *bp;
543 bp = buf->mzscheme_ref;
544 bp->buf = INVALID_BUFFER_VALUE;
545 buf->mzscheme_ref = NULL;
546 scheme_gc_ptr_ok(bp);
547 }
548 }
549
550 /*
551 * Routine called by VIM when deleting a Window
552 */
553 void
554 mzscheme_window_free(win_T *win)
555 {
556 if (win->mzscheme_ref)
557 {
558 vim_mz_window *wp;
559 wp = win->mzscheme_ref;
560 wp->win = INVALID_WINDOW_VALUE;
561 win->mzscheme_ref = NULL;
562 scheme_gc_ptr_ok(wp);
563 }
564 }
565
566 /*
567 * ":mzscheme" (or ":mz")
568 */
569 void
570 ex_mzscheme(exarg_T *eap)
571 {
572 char_u *script;
573
574 script = script_get(eap, eap->arg);
575 if (!eap->skip)
576 {
577 if (script == NULL)
578 do_mzscheme_command(eap, eap->arg, do_eval);
579 else
580 {
581 do_mzscheme_command(eap, script, do_eval);
582 vim_free(script);
583 }
584 }
585 }
586
587 /* eval MzScheme string */
588 void *
589 mzvim_eval_string(char_u *str)
590 {
591 Scheme_Object *ret = NULL;
592 if (mzscheme_init())
593 return FAIL;
594
595 eval_in_namespace(str, do_eval, get_vim_curr_buffer()->env, &ret);
596 return ret;
597 }
598
599 /*
600 * apply MzScheme procedure with arguments,
601 * handling errors
602 */
603 Scheme_Object *
604 mzvim_apply(Scheme_Object *proc, int argc, Scheme_Object **argv)
605 {
606 Apply_Info data;
607 Scheme_Object *ret = NULL;
608
609 if (mzscheme_init())
610 return FAIL;
611
612 data.proc = proc;
613 data.argc = argc;
614 data.argv = argv;
615
616 eval_in_namespace(&data, do_apply, get_vim_curr_buffer()->env, &ret);
617 return ret;
618 }
619
620 static Scheme_Object *
621 do_load(void *data, int noargc, Scheme_Object **noargv)
622 {
623 Cmd_Info *info = (Cmd_Info *)data;
624 Scheme_Object *result = scheme_void;
625 Scheme_Object *expr;
626 char_u *file = scheme_malloc_fail_ok(
627 scheme_malloc_atomic, MAXPATHL + 1);
628 Port_Info *pinfo = (Port_Info *)(info->data);
629
630 /* make Vim expansion */
631 expand_env((char_u *)pinfo->name, file, MAXPATHL);
632 /* scheme_load looks strange working with namespaces and error handling*/
633 pinfo->port = scheme_open_input_file(file, "mzfile");
634 scheme_count_lines(pinfo->port); /* to get accurate read error location*/
635
636 /* Like REPL but print only last result */
637 while (!SCHEME_EOFP(expr = scheme_read(pinfo->port)))
638 result = scheme_eval(expr, info->env);
639
640 /* errors will be caught in do_mzscheme_comamnd and ex_mzfile */
641 scheme_close_input_port(pinfo->port);
642 pinfo->port = NULL;
643 return result;
644 }
645
646 /* :mzfile */
647 void
648 ex_mzfile(exarg_T *eap)
649 {
650 Port_Info pinfo;
651
652 pinfo.name = (char *)eap->arg;
653 pinfo.port = NULL;
654 if (do_mzscheme_command(eap, &pinfo, do_load) != OK
655 && pinfo.port != NULL) /* looks like port was not closed */
656 scheme_close_input_port(pinfo.port);
657 }
658
659
660 /*
661 *========================================================================
662 * Exception handling code -- cribbed form the MzScheme sources and
663 * Matthew Flatt's "Inside PLT MzScheme" document.
664 *========================================================================
665 */
666 static void
667 init_exn_catching_apply(void)
668 {
669 if (!exn_catching_apply)
670 {
671 char *e =
672 "(lambda (thunk) "
673 "(with-handlers ([void (lambda (exn) (cons #f exn))]) "
674 "(cons #t (thunk))))";
675
676 /* make sure we have a namespace with the standard syntax: */
677 Scheme_Env *env = (Scheme_Env *)scheme_make_namespace(0, NULL);
678 add_vim_exn(env);
679
680 exn_catching_apply = scheme_eval_string(e, env);
681 exn_p = scheme_lookup_global(scheme_intern_symbol("exn?"), env);
682 exn_message = scheme_lookup_global(
683 scheme_intern_symbol("exn-message"), env);
684 }
685 }
686
687 /*
688 * This function applies a thunk, returning the Scheme value if there's
689 * no exception, otherwise returning NULL and setting *exn to the raised
690 * value (usually an exn structure).
691 */
692 static Scheme_Object *
693 _apply_thunk_catch_exceptions(Scheme_Object *f, Scheme_Object **exn)
694 {
695 Scheme_Object *v;
696
697 init_exn_catching_apply();
698
699 v = _scheme_apply(exn_catching_apply, 1, &f);
700 /* v is a pair: (cons #t value) or (cons #f exn) */
701
702 if (SCHEME_TRUEP(SCHEME_CAR(v)))
703 return SCHEME_CDR(v);
704 else
705 {
706 *exn = SCHEME_CDR(v);
707 return NULL;
708 }
709 }
710
711 static Scheme_Object *
712 extract_exn_message(Scheme_Object *v)
713 {
714 init_exn_catching_apply();
715
716 if (SCHEME_TRUEP(_scheme_apply(exn_p, 1, &v)))
717 return _scheme_apply(exn_message, 1, &v);
718 else
719 return NULL; /* Not an exn structure */
720 }
721
722 static Scheme_Object *
723 do_eval(void *s, int noargc, Scheme_Object **noargv)
724 {
725 Cmd_Info *info = (Cmd_Info *)s;
726
727 return scheme_eval_string_all((char *)(info->data), info->env, TRUE);
728 }
729
730 static Scheme_Object *
731 do_apply(void *a, int noargc, Scheme_Object **noargv)
732 {
733 Apply_Info *info = (Apply_Info *)(((Cmd_Info *)a)->data);
734
735 return scheme_apply(info->proc, info->argc, info->argv);
736 }
737
738 /*
739 *========================================================================
740 * 3. MzScheme I/O Handlers
741 *========================================================================
742 */
743 static void
744 do_intrnl_output(char *mesg, long len, int error)
745 {
746 char *p, *prev;
747
748 prev = mesg;
749 p = strchr(prev, '\n');
750 while (p)
751 {
752 *p = '\0';
753 if (error)
754 EMSG(prev);
755 else
756 MSG(prev);
757 prev = p + 1;
758 p = strchr(prev, '\n');
759 }
760
761 if (error)
762 EMSG(prev);
763 else
764 MSG(prev);
765 }
766
767 static void
768 do_output(char *mesg, long len)
769 {
770 do_intrnl_output(mesg, len, 0);
771 }
772
773 static void
774 do_err_output(char *mesg, long len)
775 {
776 do_intrnl_output(mesg, len, 1);
777 }
778
779 static void
780 do_printf(char *format, ...)
781 {
782 do_intrnl_output(format, STRLEN(format), 1);
783 }
784
785 static void
786 do_flush(void)
787 {
788 char *buff;
789 long length;
790
791 buff = scheme_get_sized_string_output(curerr, &length);
792 if (length)
793 {
794 do_err_output(buff, length);
795 return;
796 }
797
798 buff = scheme_get_sized_string_output(curout, &length);
799 if (length)
800 do_output(buff, length);
801 }
802
803 static int
804 mzscheme_io_init(void)
805 {
806 /* Nothing needed so far... */
807 return 0;
808 }
809
810 /*
811 *========================================================================
812 * 4. Implementation of the Vim Features for MzScheme
813 *========================================================================
814 */
815
816 /* (command {command-string}) */
817 static Scheme_Object *
818 vim_command(void *data, int argc, Scheme_Object **argv)
819 {
820 Vim_Prim *prim = (Vim_Prim *)data;
821 char *cmd = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0));
822
823 /* may be use do_cmdline_cmd? */
824 do_cmdline((char_u *)cmd, NULL, NULL, DOCMD_NOWAIT|DOCMD_VERBOSE);
825 update_screen(VALID);
826
827 raise_if_error();
828 return scheme_void;
829 }
830
831 /* (eval {expr-string}) */
832 static Scheme_Object *
833 vim_eval(void *data, int argc, Scheme_Object **argv)
834 {
835 #ifdef FEAT_EVAL
836 Vim_Prim *prim = (Vim_Prim *)data;
837 char *expr;
838 char *str;
839 Scheme_Object *result;
840
841 expr = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0));
842
843 str = (char *)eval_to_string((char_u *)expr, NULL);
844
845 if (str == NULL)
846 raise_vim_exn(_("invalid expression"));
847
848 result = scheme_make_string(str);
849
850 vim_free(str);
851
852 return result;
853 #else
854 raise_vim_exn(_("expressions disabled at compile time"));
855 /* unreachable */
856 return scheme_false;
857 #endif
858 }
859
860 /* (range-start) */
861 static Scheme_Object *
862 get_range_start(void *data, int argc, Scheme_Object **argv)
863 {
864 return scheme_make_integer(range_start);
865 }
866
867 /* (range-end) */
868 static Scheme_Object *
869 get_range_end(void *data, int argc, Scheme_Object **argv)
870 {
871 return scheme_make_integer(range_end);
872 }
873
874 /* (beep) */
875 static Scheme_Object *
876 mzscheme_beep(void *data, int argc, Scheme_Object **argv)
877 {
878 vim_beep();
879 return scheme_void;
880 }
881
882 static Scheme_Object *M_global = NULL;
883
884 /* (get-option {option-name}) [buffer/window] */
885 static Scheme_Object *
886 get_option(void *data, int argc, Scheme_Object **argv)
887 {
888 Vim_Prim *prim = (Vim_Prim *)data;
889 char_u *name;
890 long value;
891 char_u *strval;
892 int rc;
893 Scheme_Object *rval;
894 int opt_flags = 0;
895 buf_T *save_curb = curbuf;
896 win_T *save_curw = curwin;
897
898 name = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0));
899
900 if (argc > 1)
901 {
902 if (M_global == NULL)
903 {
904 MZ_REGISTER_STATIC(M_global);
905 M_global = scheme_intern_symbol("global");
906 }
907
908 if (argv[1] == M_global)
909 opt_flags = OPT_GLOBAL;
910 else if (SCHEME_VIMBUFFERP(argv[1]))
911 {
912 curbuf = get_valid_buffer(argv[1]);
913 opt_flags = OPT_LOCAL;
914 }
915 else if (SCHEME_VIMWINDOWP(argv[1]))
916 {
917 win_T *win = get_valid_window(argv[1]);
918
919 curwin = win;
920 curbuf = win->w_buffer;
921 opt_flags = OPT_LOCAL;
922 }
923 else
924 scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv);
925 }
926
927 rc = get_option_value(name, &value, &strval, opt_flags);
928 curbuf = save_curb;
929 curwin = save_curw;
930
931 switch (rc)
932 {
933 case 1:
934 return scheme_make_integer_value(value);
935 case 0:
936 rval = scheme_make_string(strval);
937 vim_free(strval);
938 return rval;
939 case -1:
940 case -2:
941 raise_vim_exn(_("hidden option"));
942 case -3:
943 raise_vim_exn(_("unknown option"));
944 }
945 /* unreachable */
946 return scheme_void;
947 }
948
949 /* (set-option {option-changing-string} [buffer/window]) */
950 static Scheme_Object *
951 set_option(void *data, int argc, Scheme_Object **argv)
952 {
953 char_u *cmd;
954 int opt_flags = 0;
955 buf_T *save_curb = curbuf;
956 win_T *save_curw = curwin;
957 Vim_Prim *prim = (Vim_Prim *)data;
958
959 GUARANTEE_STRING(prim->name, 0);
960 if (argc > 1)
961 {
962 if (M_global == NULL)
963 {
964 MZ_REGISTER_STATIC(M_global);
965 M_global = scheme_intern_symbol("global");
966 }
967
968 if (argv[1] == M_global)
969 opt_flags = OPT_GLOBAL;
970 else if (SCHEME_VIMBUFFERP(argv[1]))
971 {
972 curbuf = get_valid_buffer(argv[1]);
973 opt_flags = OPT_LOCAL;
974 }
975 else if (SCHEME_VIMWINDOWP(argv[1]))
976 {
977 win_T *win = get_valid_window(argv[1]);
978 curwin = win;
979 curbuf = win->w_buffer;
980 opt_flags = OPT_LOCAL;
981 }
982 else
983 scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv);
984 }
985
986 /* do_set can modify cmd, make copy */
987 cmd = vim_strsave((char_u *)SCHEME_STR_VAL(argv[0]));
988 do_set(cmd, opt_flags);
989 vim_free(cmd);
990 update_screen(NOT_VALID);
991 curbuf = save_curb;
992 curwin = save_curw;
993 raise_if_error();
994 return scheme_void;
995 }
996
997 /*
998 *===========================================================================
999 * 5. Vim Window-related Manipulation Functions
1000 *===========================================================================
1001 */
1002
1003 /* (curr-win) */
1004 static Scheme_Object *
1005 get_curr_win(void *data, int argc, Scheme_Object **argv)
1006 {
1007 return (Scheme_Object *)get_vim_curr_window();
1008 }
1009
1010 /* (win-count) */
1011 static Scheme_Object *
1012 get_window_count(void *data, int argc, Scheme_Object **argv)
1013 {
1014 win_T *w;
1015 int n = 0;
1016
1017 for (w = firstwin; w; w = w->w_next) ++n;
1018 return scheme_make_integer(n);
1019 }
1020
1021 /* (get-win-list [buffer]) */
1022 static Scheme_Object *
1023 get_window_list(void *data, int argc, Scheme_Object **argv)
1024 {
1025 Vim_Prim *prim = (Vim_Prim *)data;
1026 vim_mz_buffer *buf;
1027 Scheme_Object *list;
1028 win_T *w;
1029
1030 buf = get_buffer_arg(prim->name, 0, argc, argv);
1031 list = scheme_null;
1032
1033 for (w = firstwin; w; w = w->w_next)
1034 if (w->w_buffer == buf->buf)
1035 list = scheme_make_pair(window_new(w), list);
1036
1037 return list;
1038 }
1039
1040 static Scheme_Object *
1041 window_new(win_T *win)
1042 {
1043 vim_mz_window *self;
1044
1045 /* We need to handle deletion of windows underneath us.
1046 * If we add a "mzscheme_ref" field to the win_T structure,
1047 * then we can get at it in win_free() in vim.
1048 *
1049 * On a win_free() we set the Scheme object's win_T *field
1050 * to an invalid value. We trap all uses of a window
1051 * object, and reject them if the win_T *field is invalid.
1052 */
1053 if (win->mzscheme_ref)
1054 return win->mzscheme_ref;
1055
1056 self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_window));
1057
1058 vim_memset(self, 0, sizeof(vim_mz_window));
1059 scheme_dont_gc_ptr(self); /* because win isn't visible to GC */
1060 win->mzscheme_ref = self;
1061 self->win = win;
1062 self->tag = mz_window_type;
1063
1064 return (Scheme_Object *)(self);
1065 }
1066
1067 /* (get-win-num [window]) */
1068 static Scheme_Object *
1069 get_window_num(void *data, int argc, Scheme_Object **argv)
1070 {
1071 Vim_Prim *prim = (Vim_Prim *)data;
1072 win_T *win = get_window_arg(prim->name, 0, argc, argv)->win;
1073 int nr = 1;
1074 win_T *wp;
1075
1076 for (wp = firstwin; wp != win; wp = wp->w_next)
1077 ++nr;
1078
1079 return scheme_make_integer(nr);
1080 }
1081
1082 /* (get-win-by-num {windownum}) */
1083 static Scheme_Object *
1084 get_window_by_num(void *data, int argc, Scheme_Object **argv)
1085 {
1086 Vim_Prim *prim = (Vim_Prim *)data;
1087 win_T *win;
1088 int fnum;
1089
1090 fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1091 if (fnum < 1)
1092 scheme_signal_error(_("window index is out of range"));
1093
1094 for (win = firstwin; win; win = win->w_next, --fnum)
1095 if (fnum == 1) /* to be 1-based */
1096 return window_new(win);
1097
1098 return scheme_false;
1099 }
1100
1101 /* (get-win-buffer [window]) */
1102 static Scheme_Object *
1103 get_window_buffer(void *data, int argc, Scheme_Object **argv)
1104 {
1105 Vim_Prim *prim = (Vim_Prim *)data;
1106 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
1107
1108 return buffer_new(win->win->w_buffer);
1109 }
1110
1111 /* (get-win-height [window]) */
1112 static Scheme_Object *
1113 get_window_height(void *data, int argc, Scheme_Object **argv)
1114 {
1115 Vim_Prim *prim = (Vim_Prim *)data;
1116 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
1117
1118 return scheme_make_integer(win->win->w_height);
1119 }
1120
1121 /* (set-win-height {height} [window]) */
1122 static Scheme_Object *
1123 set_window_height(void *data, int argc, Scheme_Object **argv)
1124 {
1125 Vim_Prim *prim = (Vim_Prim *)data;
1126 vim_mz_window *win;
1127 win_T *savewin;
1128 int height;
1129
1130 win = get_window_arg(prim->name, 1, argc, argv);
1131 height = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1132
1133 #ifdef FEAT_GUI
1134 need_mouse_correct = TRUE;
1135 #endif
1136
1137 savewin = curwin;
1138 curwin = win->win;
1139 win_setheight(height);
1140 curwin = savewin;
1141
1142 raise_if_error();
1143 return scheme_void;
1144 }
1145
1146 #ifdef FEAT_VERTSPLIT
1147 /* (get-win-width [window]) */
1148 static Scheme_Object *
1149 get_window_width(void *data, int argc, Scheme_Object **argv)
1150 {
1151 Vim_Prim *prim = (Vim_Prim *)data;
1152 vim_mz_window *win = get_window_arg(prim->name, 0, argc, argv);
1153
1154 return scheme_make_integer(W_WIDTH(win->win));
1155 }
1156
1157 /* (set-win-width {width} [window]) */
1158 static Scheme_Object *
1159 set_window_width(void *data, int argc, Scheme_Object **argv)
1160 {
1161 Vim_Prim *prim = (Vim_Prim *)data;
1162 vim_mz_window *win;
1163 win_T *savewin;
1164 int width = 0;
1165
1166 win = get_window_arg(prim->name, 1, argc, argv);
1167 width = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1168
1169 # ifdef FEAT_GUI
1170 need_mouse_correct = TRUE;
1171 # endif
1172
1173 savewin = curwin;
1174 curwin = win->win;
1175 win_setwidth(width);
1176 curwin = savewin;
1177
1178 raise_if_error();
1179 return scheme_void;
1180 }
1181 #endif
1182
1183 /* (get-cursor [window]) -> (line . col) */
1184 static Scheme_Object *
1185 get_cursor(void *data, int argc, Scheme_Object **argv)
1186 {
1187 Vim_Prim *prim = (Vim_Prim *)data;
1188 vim_mz_window *win;
1189 pos_T pos;
1190
1191 win = get_window_arg(prim->name, 0, argc, argv);
1192 pos = win->win->w_cursor;
1193 return scheme_make_pair(scheme_make_integer_value((long)pos.lnum),
1194 scheme_make_integer_value((long)pos.col + 1));
1195 }
1196
1197 /* (set-cursor (line . col) [window]) */
1198 static Scheme_Object *
1199 set_cursor(void *data, int argc, Scheme_Object **argv)
1200 {
1201 Vim_Prim *prim = (Vim_Prim *)data;
1202 vim_mz_window *win;
1203 long lnum = 0;
1204 long col = 0;
1205
1206 win = get_window_arg(prim->name, 1, argc, argv);
1207 GUARANTEE_PAIR(prim->name, 0);
1208
1209 if (!SCHEME_INTP(SCHEME_CAR(argv[0]))
1210 || !SCHEME_INTP(SCHEME_CDR(argv[0])))
1211 scheme_wrong_type(prim->name, "integer pair", 0, argc, argv);
1212
1213 lnum = SCHEME_INT_VAL(SCHEME_CAR(argv[0]));
1214 col = SCHEME_INT_VAL(SCHEME_CDR(argv[0])) - 1;
1215
1216 check_line_range(lnum, win->win->w_buffer);
1217 /* don't know how to catch invalid column value */
1218
1219 win->win->w_cursor.lnum = lnum;
1220 win->win->w_cursor.col = col;
1221 update_screen(VALID);
1222
1223 raise_if_error();
1224 return scheme_void;
1225 }
1226 /*
1227 *===========================================================================
1228 * 6. Vim Buffer-related Manipulation Functions
1229 * Note that each buffer should have its own private namespace.
1230 *===========================================================================
1231 */
1232
1233 /* (open-buff {filename}) */
1234 static Scheme_Object *
1235 mzscheme_open_buffer(void *data, int argc, Scheme_Object **argv)
1236 {
1237 Vim_Prim *prim = (Vim_Prim *)data;
1238 char *fname;
1239 int num = 0;
1240 Scheme_Object *onum;
1241
1242 fname = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0));
1243 /* TODO make open existing file */
1244 num = buflist_add(fname, BLN_LISTED | BLN_CURBUF);
1245
1246 if (num == 0)
1247 raise_vim_exn(_("couldn't open buffer"));
1248
1249 onum = scheme_make_integer(num);
1250 return get_buffer_by_num(data, 1, &onum);
1251 }
1252
1253 /* (get-buff-by-num {buffernum}) */
1254 static Scheme_Object *
1255 get_buffer_by_num(void *data, int argc, Scheme_Object **argv)
1256 {
1257 Vim_Prim *prim = (Vim_Prim *)data;
1258 buf_T *buf;
1259 int fnum;
1260
1261 fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1262
1263 for (buf = firstbuf; buf; buf = buf->b_next)
1264 if (buf->b_fnum == fnum)
1265 return buffer_new(buf);
1266
1267 return scheme_false;
1268 }
1269
1270 /* (get-buff-by-name {buffername}) */
1271 static Scheme_Object *
1272 get_buffer_by_name(void *data, int argc, Scheme_Object **argv)
1273 {
1274 Vim_Prim *prim = (Vim_Prim *)data;
1275 buf_T *buf;
1276 char_u *fname;
1277
1278 fname = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0));
1279
1280 for (buf = firstbuf; buf; buf = buf->b_next)
1281 if (buf->b_ffname == NULL || buf->b_sfname == NULL)
1282 /* empty string */
1283 {
1284 if (fname[0] == NUL)
1285 return buffer_new(buf);
1286 }
1287 else if (!fnamecmp(buf->b_ffname, fname)
1288 || !fnamecmp(buf->b_sfname, fname))
1289 /* either short or long filename matches */
1290 return buffer_new(buf);
1291
1292 return scheme_false;
1293 }
1294
1295 /* (get-next-buff [buffer]) */
1296 static Scheme_Object *
1297 get_next_buffer(void *data, int argc, Scheme_Object **argv)
1298 {
1299 Vim_Prim *prim = (Vim_Prim *)data;
1300 buf_T *buf = get_buffer_arg(prim->name, 0, argc, argv)->buf;
1301
1302 if (buf->b_next == NULL)
1303 return scheme_false;
1304 else
1305 return buffer_new(buf->b_next);
1306 }
1307
1308 /* (get-prev-buff [buffer]) */
1309 static Scheme_Object *
1310 get_prev_buffer(void *data, int argc, Scheme_Object **argv)
1311 {
1312 Vim_Prim *prim = (Vim_Prim *)data;
1313 buf_T *buf = get_buffer_arg(prim->name, 0, argc, argv)->buf;
1314
1315 if (buf->b_prev == NULL)
1316 return scheme_false;
1317 else
1318 return buffer_new(buf->b_prev);
1319 }
1320
1321 /* (get-buff-num [buffer]) */
1322 static Scheme_Object *
1323 get_buffer_num(void *data, int argc, Scheme_Object **argv)
1324 {
1325 Vim_Prim *prim = (Vim_Prim *)data;
1326 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
1327
1328 return scheme_make_integer(buf->buf->b_fnum);
1329 }
1330
1331 /* (buff-count) */
1332 static Scheme_Object *
1333 get_buffer_count(void *data, int argc, Scheme_Object **argv)
1334 {
1335 buf_T *b;
1336 int n = 0;
1337
1338 for (b = firstbuf; b; b = b->b_next) ++n;
1339 return scheme_make_integer(n);
1340 }
1341
1342 /* (get-buff-name [buffer]) */
1343 static Scheme_Object *
1344 get_buffer_name(void *data, int argc, Scheme_Object **argv)
1345 {
1346 Vim_Prim *prim = (Vim_Prim *)data;
1347 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
1348
1349 return scheme_make_string(buf->buf->b_ffname);
1350 }
1351
1352 /* (curr-buff) */
1353 static Scheme_Object *
1354 get_curr_buffer(void *data, int argc, Scheme_Object **argv)
1355 {
1356 return (Scheme_Object *)get_vim_curr_buffer();
1357 }
1358
1359 static Scheme_Object *
1360 buffer_new(buf_T *buf)
1361 {
1362 vim_mz_buffer *self;
1363
1364 /* We need to handle deletion of buffers underneath us.
1365 * If we add a "mzscheme_buf" field to the buf_T structure,
1366 * then we can get at it in buf_freeall() in vim.
1367 */
1368 if (buf->mzscheme_ref)
1369 return buf->mzscheme_ref;
1370
1371 self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_buffer));
1372
1373 vim_memset(self, 0, sizeof(vim_mz_buffer));
1374 scheme_dont_gc_ptr(self); /* because buf isn't visible to GC */
1375 buf->mzscheme_ref = self;
1376 self->buf = buf;
1377 self->tag = mz_buffer_type;
1378
1379 mzscheme_interface_init(self); /* Set up namespace */
1380
1381 return (Scheme_Object *)(self);
1382 }
1383
1384 /*
1385 * (get-buff-size [buffer])
1386 *
1387 * Get the size (number of lines) in the current buffer.
1388 */
1389 static Scheme_Object *
1390 get_buffer_size(void *data, int argc, Scheme_Object **argv)
1391 {
1392 Vim_Prim *prim = (Vim_Prim *)data;
1393 vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv);
1394
1395 return scheme_make_integer(buf->buf->b_ml.ml_line_count);
1396 }
1397
1398 /*
1399 * (get-buff-line {linenr} [buffer])
1400 *
1401 * Get a line from the specified buffer. The line number is
1402 * in Vim format (1-based). The line is returned as a MzScheme
1403 * string object.
1404 */
1405 static Scheme_Object *
1406 get_buffer_line(void *data, int argc, Scheme_Object **argv)
1407 {
1408 Vim_Prim *prim = (Vim_Prim *)data;
1409 vim_mz_buffer *buf;
1410 int linenr;
1411 char *line;
1412
1413 buf = get_buffer_arg(prim->name, 1, argc, argv);
1414 linenr = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1415 line = ml_get_buf(buf->buf, (linenr_T)linenr, FALSE);
1416
1417 raise_if_error();
1418 return scheme_make_string(line);
1419 }
1420
1421
1422 /*
1423 * (get-buff-line-list {start} {end} [buffer])
1424 *
1425 * Get a list of lines from the specified buffer. The line numbers
1426 * are in Vim format (1-based). The range is from lo up to, but not
1427 * including, hi. The list is returned as a list of string objects.
1428 */
1429 static Scheme_Object *
1430 get_buffer_line_list(void *data, int argc, Scheme_Object **argv)
1431 {
1432 Vim_Prim *prim = (Vim_Prim *)data;
1433 vim_mz_buffer *buf;
1434 int i, hi, lo, n;
1435 Scheme_Object *list;
1436
1437 buf = get_buffer_arg(prim->name, 2, argc, argv);
1438 list = scheme_null;
1439 hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1));
1440 lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1441
1442 /*
1443 * Handle some error conditions
1444 */
1445 if (lo < 0)
1446 lo = 0;
1447
1448 if (hi < 0)
1449 hi = 0;
1450 if (hi < lo)
1451 hi = lo;
1452
1453 n = hi - lo;
1454
1455 for (i = n; i >= 0; --i)
1456 {
1457 Scheme_Object *str = scheme_make_string(
1458 (char *)ml_get_buf(buf->buf, (linenr_T)(lo+i), FALSE));
1459 raise_if_error();
1460
1461 /* Set the list item */
1462 list = scheme_make_pair(str, list);
1463 }
1464
1465 return list;
1466 }
1467
1468 /*
1469 * (set-buff-line {linenr} {string/#f} [buffer])
1470 *
1471 * Replace a line in the specified buffer. The line number is
1472 * in Vim format (1-based). The replacement line is given as
1473 * an MzScheme string object. The object is checked for validity
1474 * and correct format. An exception is thrown if the values are not
1475 * the correct format.
1476 *
1477 * It returns a Scheme Object that indicates the length of the
1478 * string changed.
1479 */
1480 static Scheme_Object *
1481 set_buffer_line(void *data, int argc, Scheme_Object **argv)
1482 {
1483 /* First of all, we check the the of the supplied MzScheme object.
1484 * There are three cases:
1485 * 1. #f - this is a deletion.
1486 * 2. A string - this is a replacement.
1487 * 3. Anything else - this is an error.
1488 */
1489 Vim_Prim *prim = (Vim_Prim *)data;
1490 vim_mz_buffer *buf;
1491 Scheme_Object *line;
1492 char *save;
1493 buf_T *savebuf;
1494 int n;
1495
1496 n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1497 if (!SCHEME_STRINGP(argv[1]) && !SCHEME_FALSEP(argv[1]))
1498 scheme_wrong_type(prim->name, "string or #f", 1, argc, argv);
1499 line = argv[1];
1500 buf = get_buffer_arg(prim->name, 2, argc, argv);
1501
1502 check_line_range(n, buf->buf);
1503
1504 if (SCHEME_FALSEP(line))
1505 {
1506 savebuf = curbuf;
1507 curbuf = buf->buf;
1508
1509 if (u_savedel((linenr_T)n, 1L) == FAIL)
1510 {
1511 curbuf = savebuf;
1512 raise_vim_exn(_("cannot save undo information"));
1513 }
1514 else if (ml_delete((linenr_T)n, FALSE) == FAIL)
1515 {
1516 curbuf = savebuf;
1517 raise_vim_exn(_("cannot delete line"));
1518 }
1519 deleted_lines_mark((linenr_T)n, 1L);
1520 if (buf->buf == curwin->w_buffer)
1521 mz_fix_cursor(n, n + 1, -1);
1522
1523 curbuf = savebuf;
1524
1525 raise_if_error();
1526 return scheme_void;
1527 }
1528
1529 /* Otherwise it's a line */
1530 save = string_to_line(line);
1531 savebuf = curbuf;
1532
1533 curbuf = buf->buf;
1534
1535 if (u_savesub((linenr_T)n) == FAIL)
1536 {
1537 curbuf = savebuf;
1538 raise_vim_exn(_("cannot save undo information"));
1539 }
1540 else if (ml_replace((linenr_T)n, (char_u *)save, TRUE) == FAIL)
1541 {
1542 curbuf = savebuf;
1543 raise_vim_exn(_("cannot replace line"));
1544 }
1545 else
1546 changed_bytes((linenr_T)n, 0);
1547
1548 curbuf = savebuf;
1549
1550 raise_if_error();
1551 return scheme_void;
1552 }
1553
1554 /*
1555 * (set-buff-line-list {start} {end} {string-list/#f/null} [buffer])
1556 *
1557 * Replace a range of lines in the specified buffer. The line numbers are in
1558 * Vim format (1-based). The range is from lo up to, but not including, hi.
1559 * The replacement lines are given as a Scheme list of string objects. The
1560 * list is checked for validity and correct format.
1561 *
1562 * Errors are returned as a value of FAIL. The return value is OK on success.
1563 * If OK is returned and len_change is not NULL, *len_change is set to the
1564 * change in the buffer length.
1565 */
1566 static Scheme_Object *
1567 set_buffer_line_list(void *data, int argc, Scheme_Object **argv)
1568 {
1569 /* First of all, we check the type of the supplied MzScheme object.
1570 * There are three cases:
1571 * 1. #f - this is a deletion.
1572 * 2. A list - this is a replacement.
1573 * 3. Anything else - this is an error.
1574 */
1575 Vim_Prim *prim = (Vim_Prim *)data;
1576 vim_mz_buffer *buf;
1577 Scheme_Object *line_list;
1578 Scheme_Object *line;
1579 Scheme_Object *rest;
1580 char **array;
1581 buf_T *savebuf;
1582 int i, old_len, new_len, hi, lo;
1583 long extra;
1584
1585 lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1586 hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1));
1587 if (!SCHEME_PAIRP(argv[2])
1588 && !SCHEME_FALSEP(argv[2]) && !SCHEME_NULLP(argv[2]))
1589 scheme_wrong_type(prim->name, "list or #f", 2, argc, argv);
1590 line_list = argv[2];
1591 buf = get_buffer_arg(prim->name, 3, argc, argv);
1592 old_len = hi - lo;
1593 if (old_len < 0) /* process inverse values wisely */
1594 {
1595 i = lo;
1596 lo = hi;
1597 hi = i;
1598 old_len = -old_len;
1599 }
1600 extra = 0;
1601
1602 check_line_range(lo, buf->buf); /* inclusive */
1603 check_line_range(hi - 1, buf->buf); /* exclisive */
1604
1605 if (SCHEME_FALSEP(line_list) || SCHEME_NULLP(line_list))
1606 {
1607 savebuf = curbuf;
1608 curbuf = buf->buf;
1609
1610 if (u_savedel((linenr_T)lo, (long)old_len) == FAIL)
1611 {
1612 curbuf = savebuf;
1613 raise_vim_exn(_("cannot save undo information"));
1614 }
1615 else
1616 {
1617 for (i = 0; i < old_len; i++)
1618 if (ml_delete((linenr_T)lo, FALSE) == FAIL)
1619 {
1620 curbuf = savebuf;
1621 raise_vim_exn(_("cannot delete line"));
1622 }
1623 deleted_lines_mark((linenr_T)lo, (long)old_len);
1624 if (buf->buf == curwin->w_buffer)
1625 mz_fix_cursor(lo, hi, -old_len);
1626 }
1627
1628 curbuf = savebuf;
1629
1630 raise_if_error();
1631 return scheme_void;
1632 }
1633
1634 /* List */
1635 new_len = scheme_proper_list_length(line_list);
1636 if (new_len < 0) /* improper or cyclic list */
1637 scheme_wrong_type(prim->name, "proper list",
1638 2, argc, argv);
1639
1640 /* Using MzScheme allocator, so we don't need to free this and
1641 * can safely keep pointers to GC collected strings
1642 */
1643 array = (char **)scheme_malloc_fail_ok(scheme_malloc,
1644 (unsigned)(new_len * sizeof(char *)));
1645
1646 rest = line_list;
1647 for (i = 0; i < new_len; ++i)
1648 {
1649 line = SCHEME_CAR(rest);
1650 rest = SCHEME_CDR(rest);
1651 if (!SCHEME_STRINGP(line))
1652 scheme_wrong_type(prim->name, "string-list", 2, argc, argv);
1653 array[i] = string_to_line(line);
1654 }
1655
1656 savebuf = curbuf;
1657 curbuf = buf->buf;
1658
1659 if (u_save((linenr_T)(lo-1), (linenr_T)hi) == FAIL)
1660 {
1661 curbuf = savebuf;
1662 raise_vim_exn(_("cannot save undo information"));
1663 }
1664
1665 /*
1666 * If the size of the range is reducing (ie, new_len < old_len) we
1667 * need to delete some old_len. We do this at the start, by
1668 * repeatedly deleting line "lo".
1669 */
1670 for (i = 0; i < old_len - new_len; ++i)
1671 {
1672 if (ml_delete((linenr_T)lo, FALSE) == FAIL)
1673 {
1674 curbuf = savebuf;
1675 raise_vim_exn(_("cannot delete line"));
1676 }
1677 extra--;
1678 }
1679
1680 /*
1681 * For as long as possible, replace the existing old_len with the
1682 * new old_len. This is a more efficient operation, as it requires
1683 * less memory allocation and freeing.
1684 */
1685 for (i = 0; i < old_len && i < new_len; i++)
1686 if (ml_replace((linenr_T)(lo+i), (char_u *)array[i], TRUE) == FAIL)
1687 {
1688 curbuf = savebuf;
1689 raise_vim_exn(_("cannot replace line"));
1690 }
1691
1692 /*
1693 * Now we may need to insert the remaining new_len. We don't need to
1694 * free the string passed back because MzScheme has control of that
1695 * memory.
1696 */
1697 while (i < new_len)
1698 {
1699 if (ml_append((linenr_T)(lo + i - 1),
1700 (char_u *)array[i], 0, FALSE) == FAIL)
1701 {
1702 curbuf = savebuf;
1703 raise_vim_exn(_("cannot insert line"));
1704 }
1705 ++i;
1706 ++extra;
1707 }
1708
1709 /*
1710 * Adjust marks. Invalidate any which lie in the
1711 * changed range, and move any in the remainder of the buffer.
1712 */
1713 mark_adjust((linenr_T)lo, (linenr_T)(hi - 1), (long)MAXLNUM, (long)extra);
1714 changed_lines((linenr_T)lo, 0, (linenr_T)hi, (long)extra);
1715
1716 if (buf->buf == curwin->w_buffer)
1717 mz_fix_cursor(lo, hi, extra);
1718 curbuf = savebuf;
1719
1720 raise_if_error();
1721 return scheme_void;
1722 }
1723
1724 /*
1725 * (insert-buff-line-list {linenr} {string/string-list} [buffer])
1726 *
1727 * Insert a number of lines into the specified buffer after the specifed line.
1728 * The line number is in Vim format (1-based). The lines to be inserted are
1729 * given as an MzScheme list of string objects or as a single string. The lines
1730 * to be added are checked for validity and correct format. Errors are
1731 * returned as a value of FAIL. The return value is OK on success.
1732 * If OK is returned and len_change is not NULL, *len_change
1733 * is set to the change in the buffer length.
1734 */
1735 static Scheme_Object *
1736 insert_buffer_line_list(void *data, int argc, Scheme_Object **argv)
1737 {
1738 Vim_Prim *prim = (Vim_Prim *)data;
1739 vim_mz_buffer *buf;
1740 Scheme_Object *list;
1741 Scheme_Object *line;
1742 Scheme_Object *rest;
1743 char **array;
1744 char *str;
1745 buf_T *savebuf;
1746 int i, n, size;
1747
1748 /*
1749 * First of all, we check the type of the supplied MzScheme object.
1750 * It must be a string or a list, or the call is in error.
1751 */
1752 n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
1753 list = argv[1];
1754
1755 if (!SCHEME_STRINGP(list) && !SCHEME_PAIRP(list))
1756 scheme_wrong_type(prim->name, "string or list", 1, argc, argv);
1757 buf = get_buffer_arg(prim->name, 2, argc, argv);
1758
1759 if (n != 0) /* 0 can be used in insert */
1760 check_line_range(n, buf->buf);
1761 if (SCHEME_STRINGP(list))
1762 {
1763 str = string_to_line(list);
1764
1765 savebuf = curbuf;
1766 curbuf = buf->buf;
1767
1768 if (u_save((linenr_T)n, (linenr_T)(n+1)) == FAIL)
1769 {
1770 curbuf = savebuf;
1771 raise_vim_exn(_("cannot save undo information"));
1772 }
1773 else if (ml_append((linenr_T)n, (char_u *)str, 0, FALSE) == FAIL)
1774 {
1775 curbuf = savebuf;
1776 raise_vim_exn(_("cannot insert line"));
1777 }
1778 else
1779 appended_lines_mark((linenr_T)n, 1L);
1780
1781 curbuf = savebuf;
1782 update_screen(VALID);
1783
1784 raise_if_error();
1785 return scheme_void;
1786 }
1787
1788 /* List */
1789 size = scheme_proper_list_length(list);
1790 if (size < 0) /* improper or cyclic list */
1791 scheme_wrong_type(prim->name, "proper list",
1792 2, argc, argv);
1793
1794 /* Using MzScheme allocator, so we don't need to free this and
1795 * can safely keep pointers to GC collected strings
1796 */
1797 array = (char **)scheme_malloc_fail_ok(
1798 scheme_malloc, (unsigned)(size * sizeof(char *)));
1799
1800 rest = list;
1801 for (i = 0; i < size; ++i)
1802 {
1803 line = SCHEME_CAR(rest);
1804 rest = SCHEME_CDR(rest);
1805 array[i] = string_to_line(line);
1806 }
1807
1808 savebuf = curbuf;
1809 curbuf = buf->buf;
1810
1811 if (u_save((linenr_T)n, (linenr_T)(n + 1)) == FAIL)
1812 {
1813 curbuf = savebuf;
1814 raise_vim_exn(_("cannot save undo information"));
1815 }
1816 else
1817 {
1818 for (i = 0; i < size; ++i)
1819 if (ml_append((linenr_T)(n + i), (char_u *)array[i],
1820 0, FALSE) == FAIL)
1821 {
1822 curbuf = savebuf;
1823 raise_vim_exn(_("cannot insert line"));
1824 }
1825
1826 if (i > 0)
1827 appended_lines_mark((linenr_T)n, (long)i);
1828 }
1829
1830 curbuf = savebuf;
1831 update_screen(VALID);
1832
1833 raise_if_error();
1834 return scheme_void;
1835 }
1836
1837 /* (get-buff-namespace [buffer]) */
1838 static Scheme_Object *
1839 get_buffer_namespace(void *data, int argc, Scheme_Object **argv)
1840 {
1841 Vim_Prim *prim = (Vim_Prim *)data;
1842
1843 return (Scheme_Object *)get_buffer_arg(prim->name, 0, argc, argv)->env;
1844 }
1845
1846 /*
1847 * Predicates
1848 */
1849 /* (buff? obj) */
1850 static Scheme_Object *
1851 vim_bufferp(void *data, int argc, Scheme_Object **argv)
1852 {
1853 if (SCHEME_VIMBUFFERP(argv[0]))
1854 return scheme_true;
1855 else
1856 return scheme_false;
1857 }
1858
1859 /* (win? obj) */
1860 static Scheme_Object *
1861 vim_windowp(void *data, int argc, Scheme_Object **argv)
1862 {
1863 if (SCHEME_VIMWINDOWP(argv[0]))
1864 return scheme_true;
1865 else
1866 return scheme_false;
1867 }
1868
1869 /* (buff-valid? obj) */
1870 static Scheme_Object *
1871 vim_buffer_validp(void *data, int argc, Scheme_Object **argv)
1872 {
1873 if (SCHEME_VIMBUFFERP(argv[0])
1874 && ((vim_mz_buffer *)argv[0])->buf != INVALID_BUFFER_VALUE)
1875 return scheme_true;
1876 else
1877 return scheme_false;
1878 }
1879
1880 /* (win-valid? obj) */
1881 static Scheme_Object *
1882 vim_window_validp(void *data, int argc, Scheme_Object **argv)
1883 {
1884 if (SCHEME_VIMWINDOWP(argv[0])
1885 && ((vim_mz_window *)argv[0])->win != INVALID_WINDOW_VALUE)
1886 return scheme_true;
1887 else
1888 return scheme_false;
1889 }
1890
1891 /*
1892 *===========================================================================
1893 * Utilities
1894 *===========================================================================
1895 */
1896
1897 /*
1898 * Convert an MzScheme string into a Vim line.
1899 *
1900 * The result is in allocated memory. All internal nulls are replaced by
1901 * newline characters. It is an error for the string to contain newline
1902 * characters.
1903 *
1904 */
1905 static char *
1906 string_to_line(Scheme_Object *obj)
1907 {
1908 char *str;
1909 long len;
1910 int i;
1911
1912 str = scheme_display_to_string(obj, &len);
1913
1914 /* Error checking: String must not contain newlines, as we
1915 * are replacing a single line, and we must replace it with
1916 * a single line.
1917 */
1918 if (memchr(str, '\n', len))
1919 scheme_signal_error(_("string cannot contain newlines"));
1920
1921 /* Create a copy of the string, with internal nulls replaced by
1922 * newline characters, as is the vim convention.
1923 */
1924 for (i = 0; i < len; ++i)
1925 {
1926 if (str[i] == '\0')
1927 str[i] = '\n';
1928 }
1929
1930 str[i] = '\0';
1931
1932 return str;
1933 }
1934
1935 /*
1936 * Check to see whether a Vim error has been reported, or a keyboard
1937 * interrupt (from vim --> got_int) has been detected.
1938 */
1939 static int
1940 vim_error_check(void)
1941 {
1942 return (got_int || did_emsg);
1943 }
1944
1945 /*
1946 * register Scheme exn:vim
1947 */
1948 static void
1949 register_vim_exn(Scheme_Env *env)
1950 {
1951 Scheme_Object *exn_name = scheme_intern_symbol("exn:vim");
1952
1953 if (vim_exn == NULL)
1954 vim_exn = scheme_make_struct_type(exn_name,
1955 scheme_builtin_value("struct:exn"), NULL, 0, 0, NULL, NULL
1956 #if MZSCHEME_VERSION_MAJOR >= 299
1957 , NULL
1958 #endif
1959 );
1960
1961 if (vim_exn_values == NULL)
1962 {
1963 int nc = 0;
1964
1965 Scheme_Object **exn_names = scheme_make_struct_names(
1966 exn_name, scheme_null, 0, &nc);
1967 Scheme_Object **exn_values = scheme_make_struct_values(
1968 vim_exn, exn_names, nc, 0);
1969
1970 vim_exn_names = scheme_make_vector(nc, scheme_false);
1971 vim_exn_values = scheme_make_vector(nc, scheme_false);
1972 /* remember names and values */
1973 mch_memmove(SCHEME_VEC_ELS(vim_exn_names), exn_names,
1974 nc * sizeof(Scheme_Object *));
1975 mch_memmove(SCHEME_VEC_ELS(vim_exn_values), exn_values,
1976 nc * sizeof(Scheme_Object *));
1977 }
1978
1979 add_vim_exn(env);
1980 }
1981
1982 /*
1983 * Add stuff of exn:vim to env
1984 */
1985 static void
1986 add_vim_exn(Scheme_Env *env)
1987 {
1988 int i;
1989
1990 for (i = 0; i < SCHEME_VEC_SIZE(vim_exn_values); i++)
1991 scheme_add_global_symbol(SCHEME_VEC_ELS(vim_exn_names)[i],
1992 SCHEME_VEC_ELS(vim_exn_values)[i], env);
1993 }
1994
1995 /*
1996 * raise exn:vim, may be with additional info string
1997 */
1998 void
1999 raise_vim_exn(const char *add_info)
2000 {
2001 Scheme_Object *argv[2];
2002 char_u *fmt = _("Vim error: ~a");
2003
2004 if (add_info != NULL)
2005 {
2006 Scheme_Object *info = scheme_make_string(add_info);
2007 argv[0] = scheme_make_string(
2008 scheme_format(fmt, strlen(fmt), 1, &info, NULL));
2009 }
2010 else
2011 argv[0] = scheme_make_string(_("Vim error"));
2012
2013 argv[1] = scheme_current_continuation_marks();
2014
2015 scheme_raise(scheme_make_struct_instance(vim_exn, 2, argv));
2016 }
2017
2018 void
2019 raise_if_error(void)
2020 {
2021 if (vim_error_check())
2022 raise_vim_exn(NULL);
2023 }
2024
2025 /* get buffer:
2026 * either current
2027 * or passed as argv[argnum] with checks
2028 */
2029 static vim_mz_buffer *
2030 get_buffer_arg(const char *fname, int argnum, int argc, Scheme_Object **argv)
2031 {
2032 vim_mz_buffer *b;
2033
2034 if (argc < argnum + 1)
2035 return get_vim_curr_buffer();
2036 if (!SCHEME_VIMBUFFERP(argv[argnum]))
2037 scheme_wrong_type(fname, "vim-buffer", argnum, argc, argv);
2038 b = (vim_mz_buffer *)argv[argnum];
2039 (void)get_valid_buffer(argv[argnum]);
2040 return b;
2041 }
2042
2043 /* get window:
2044 * either current
2045 * or passed as argv[argnum] with checks
2046 */
2047 static vim_mz_window *
2048 get_window_arg(const char *fname, int argnum, int argc, Scheme_Object **argv)
2049 {
2050 vim_mz_window *w;
2051
2052 if (argc < argnum + 1)
2053 return get_vim_curr_window();
2054 w = (vim_mz_window *)argv[argnum];
2055 if (!SCHEME_VIMWINDOWP(argv[argnum]))
2056 scheme_wrong_type(fname, "vim-window", argnum, argc, argv);
2057 (void)get_valid_window(argv[argnum]);
2058 return w;
2059 }
2060
2061 /* get valid Vim buffer from Scheme_Object* */
2062 buf_T *get_valid_buffer(void *obj)
2063 {
2064 buf_T *buf = ((vim_mz_buffer *)obj)->buf;
2065
2066 if (buf == INVALID_BUFFER_VALUE)
2067 scheme_signal_error(_("buffer is invalid"));
2068 return buf;
2069 }
2070
2071 /* get valid Vim window from Scheme_Object* */
2072 win_T *get_valid_window(void *obj)
2073 {
2074 win_T *win = ((vim_mz_window *)obj)->win;
2075 if (win == INVALID_WINDOW_VALUE)
2076 scheme_signal_error(_("window is invalid"));
2077 return win;
2078 }
2079
2080 #if 0
2081 int
2082 mzvim_bufferp(Scheme_Object *obj)
2083 {
2084 return SCHEME_VIMBUFFERP(obj);
2085 }
2086
2087 int
2088 mzvim_windowp(Scheme_Object *obj)
2089 {
2090 return SCHEME_VIMWINDOWP(obj);
2091 }
2092 #endif
2093
2094 int
2095 mzthreads_allowed(void)
2096 {
2097 return mz_threads_allow;
2098 }
2099
2100 static int
2101 line_in_range(linenr_T lnum, buf_T *buf)
2102 {
2103 return (lnum > 0 && lnum <= buf->b_ml.ml_line_count);
2104 }
2105
2106 static void
2107 check_line_range(linenr_T lnum, buf_T *buf)
2108 {
2109 if (!line_in_range(lnum, buf))
2110 scheme_signal_error(_("linenr out of range"));
2111 }
2112
2113 /*
2114 * Check if deleting lines made the cursor position invalid
2115 * (or you'll get msg from Vim about invalid linenr).
2116 * Changed the lines from "lo" to "hi" and added "extra" lines (negative if
2117 * deleted). Got from if_python.c
2118 */
2119 static void
2120 mz_fix_cursor(int lo, int hi, int extra)
2121 {
2122 if (curwin->w_cursor.lnum >= lo)
2123 {
2124 /* Adjust the cursor position if it's in/after the changed
2125 * lines. */
2126 if (curwin->w_cursor.lnum >= hi)
2127 {
2128 curwin->w_cursor.lnum += extra;
2129 check_cursor_col();
2130 }
2131 else if (extra < 0)
2132 {
2133 curwin->w_cursor.lnum = lo;
2134 check_cursor();
2135 }
2136 changed_cline_bef_curs();
2137 }
2138 invalidate_botline();
2139 }
2140
2141 static Vim_Prim prims[]=
2142 {
2143 /*
2144 * Buffer-related commands
2145 */
2146 {get_buffer_line, "get-buff-line", 1, 2},
2147 {set_buffer_line, "set-buff-line", 2, 3},
2148 {get_buffer_line_list, "get-buff-line-list", 2, 3},
2149 {get_buffer_name, "get-buff-name", 0, 1},
2150 {get_buffer_num, "get-buff-num", 0, 1},
2151 {get_buffer_size, "get-buff-size", 0, 1},
2152 {set_buffer_line_list, "set-buff-line-list", 3, 4},
2153 {insert_buffer_line_list, "insert-buff-line-list", 2, 3},
2154 {get_curr_buffer, "curr-buff", 0, 0},
2155 {get_buffer_count, "buff-count", 0, 0},
2156 {get_next_buffer, "get-next-buff", 0, 1},
2157 {get_prev_buffer, "get-prev-buff", 0, 1},
2158 {mzscheme_open_buffer, "open-buff", 1, 1},
2159 {get_buffer_by_name, "get-buff-by-name", 1, 1},
2160 {get_buffer_by_num, "get-buff-by-num", 1, 1},
2161 {get_buffer_namespace, "get-buff-namespace", 0, 1},
2162 /*
2163 * Window-related commands
2164 */
2165 {get_curr_win, "curr-win", 0, 0},
2166 {get_window_count, "win-count", 0, 0},
2167 {get_window_by_num, "get-win-by-num", 1, 1},
2168 {get_window_num, "get-win-num", 0, 1},
2169 {get_window_buffer, "get-win-buffer", 0, 1},
2170 {get_window_height, "get-win-height", 0, 1},
2171 {set_window_height, "set-win-height", 1, 2},
2172 #ifdef FEAT_VERTSPLIT
2173 {get_window_width, "get-win-width", 0, 1},
2174 {set_window_width, "set-win-width", 1, 2},
2175 #endif
2176 {get_cursor, "get-cursor", 0, 1},
2177 {set_cursor, "set-cursor", 1, 2},
2178 {get_window_list, "get-win-list", 0, 1},
2179 /*
2180 * Vim-related commands
2181 */
2182 {vim_command, "command", 1, 1},
2183 {vim_eval, "eval", 1, 1},
2184 {get_range_start, "range-start", 0, 0},
2185 {get_range_end, "range-end", 0, 0},
2186 {mzscheme_beep, "beep", 0, 0},
2187 {get_option, "get-option", 1, 2},
2188 {set_option, "set-option", 1, 2},
2189 /*
2190 * small utilities
2191 */
2192 {vim_bufferp, "buff?", 1, 1},
2193 {vim_windowp, "win?", 1, 1},
2194 {vim_buffer_validp, "buff-valid?", 1, 1},
2195 {vim_window_validp, "win-valid?", 1, 1}
2196 };
2197
2198 /* return MzScheme wrapper for curbuf */
2199 static vim_mz_buffer *
2200 get_vim_curr_buffer(void)
2201 {
2202 if (!curbuf->mzscheme_ref)
2203 return (vim_mz_buffer *)buffer_new(curbuf);
2204 else
2205 return (vim_mz_buffer *)curbuf->mzscheme_ref;
2206 }
2207
2208 /* return MzScheme wrapper for curwin */
2209 static vim_mz_window *
2210 get_vim_curr_window(void)
2211 {
2212 if (!curwin->mzscheme_ref)
2213 return (vim_mz_window *)window_new(curwin);
2214 else
2215 return (vim_mz_window *)curwin->mzscheme_ref;
2216 }
2217
2218 #if 0
2219 char *
2220 mzscheme_version(void)
2221 {
2222 return scheme_version();
2223 }
2224 #endif
2225
2226 static void
2227 make_modules(Scheme_Env *env)
2228 {
2229 int i;
2230 Scheme_Env *mod;
2231
2232 mod = scheme_primitive_module(scheme_intern_symbol("vimext"), env);
2233 /* all prims made closed so they can access their own names */
2234 for (i = 0; i < sizeof(prims)/sizeof(prims[0]); i++)
2235 {
2236 Vim_Prim *prim = prims + i;
2237 scheme_add_global(prim->name,
2238 scheme_make_closed_prim_w_arity(prim->prim, prim, prim->name,
2239 prim->mina, prim->maxa),
2240 mod);
2241 }
2242 scheme_add_global("global-namespace", (Scheme_Object *)environment, mod);
2243 scheme_finish_primitive_module(mod);
2244 }