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