1 /* vi:set ts=8 sts=4 sw=4 noet: 2 * 3 * VIM - Vi IMproved by Bram Moolenaar 4 * 5 * Do ":help uganda" in Vim to read copying and usage conditions. 6 * Do ":help credits" in Vim to see a list of people who contributed. 7 * See README.txt for an overview of the Vim source code. 8 */ 9 10 /* 11 * Tcl extensions by Ingo Wilken <[email protected]> 12 * Last modification: Wed May 10 21:28:44 CEST 2000 13 * Requires Tcl 8.0 or higher. 14 * 15 * Variables: 16 * ::vim::current(buffer) # Name of buffer command for current buffer. 17 * ::vim::current(window) # Name of window command for current window. 18 * ::vim::range(start) # Start of current range (line number). 19 * ::vim::range(end) # End of current range (line number). 20 * ::vim::lbase # Start of line/column numbers (1 or 0). 21 * 22 * Commands: 23 * ::vim::command {cmd} # Execute ex command {cmd}. 24 * ::vim::option {opt} [val] # Get/Set option {opt}. 25 * ::vim::expr {expr} # Evaluate {expr} using vim's evaluator. 26 * ::vim::beep # Guess. 27 * 28 * set buf [::vim::buffer {n}] # Create Tcl command for buffer N. 29 * set bl [::vim::buffer list] # Get list of Tcl commands of all buffers. 30 * ::vim::buffer exists {n} # True if buffer {n} exists. 31 * 32 * set wl [::vim::window list] # Get list of Tcl commands of all windows. 33 * 34 * set n [$win height] # Report window height. 35 * $win height {n} # Set window height to {n}. 36 * array set pos [$win cursor] # Get cursor position. 37 * $win cursor {row} {col} # Set cursor position. 38 * $win cursor pos # Set cursor position from array var "pos" 39 * $win delcmd {cmd} # Register callback command for closed window. 40 * $win option {opt} [val] # Get/Set vim option in context of $win. 41 * $win command {cmd} # Execute ex command in context of $win. 42 * $win expr {expr} # Evaluate vim expression in context of $win. 43 * set buf [$win buffer] # Create Tcl command for window's buffer. 44 * 45 * $buf name # Reports file name in buffer. 46 * $buf number # Reports buffer number. 47 * set l [$buf get {n}] # Get buffer line {n} as a string. 48 * set L [$buf get {n} {m}] # Get lines {n} through {m} as a list. 49 * $buf count # Reports number of lines in buffer. 50 * $buf last # Reports number of last line in buffer. 51 * $buf delete {n} # Delete line {n}. 52 * $buf delete {n} {m} # Delete lines {n} through {m}. 53 * $buf set {n} {l} # Set line {n} to string {l}. 54 * $buf set {n} {m} {L} # Set lines {n} through {m} from list {L}. 55 * # Delete/inserts lines as appropriate. 56 * $buf option {opt} [val] # Get/Set vim option in context of $buf. 57 * $buf command {cmd} # Execute ex command in context of $buf 58 * $buf expr {cmd} # Evaluate vim expression in context of $buf. 59 * array set pos [$buf mark {m}] # Get position of mark. 60 * $buf append {n} {str} # Append string {str} to buffer,after line {n}. 61 * $buf insert {n} {str} # Insert string {str} in buffer as line {n}. 62 * $buf delcmd {cmd} # Register callback command for deleted buffer. 63 * set wl [$buf windows] # Get list of Tcl commands for all windows of 64 * # this buffer. 65 TODO: 66 * ::vim::buffer new # create new buffer + Tcl command 67 */ 68 69 #include "vim.h" 70 #undef EXTERN /* tcl.h defines it too */ 71 72 #ifdef DYNAMIC_TCL 73 # define USE_TCL_STUBS /* use tcl's stubs mechanism */ 74 #endif 75 76 #include <tcl.h> 77 #include <string.h> 78 79 typedef struct 80 { 81 Tcl_Interp *interp; 82 int exitvalue; 83 int range_start, range_end; 84 int lbase; 85 char *curbuf, *curwin; 86 } tcl_info; 87 88 static tcl_info tclinfo = { NULL, 0, 0, 0, 0, NULL, NULL }; 89 90 #define VAR_RANGE1 "::vim::range(start)" 91 #define VAR_RANGE2 "::vim::range(begin)" 92 #define VAR_RANGE3 "::vim::range(end)" 93 #define VAR_CURBUF "::vim::current(buffer)" 94 #define VAR_CURWIN "::vim::current(window)" 95 #define VAR_LBASE "::vim::lbase" 96 #define VAR_CURLINE "line" 97 #define VAR_CURLNUM "lnum" 98 #define VARNAME_SIZE 64 99 100 #define row2tcl(x) ((x) - (tclinfo.lbase==0)) 101 #define row2vim(x) ((x) + (tclinfo.lbase==0)) 102 #define col2tcl(x) ((x) + (tclinfo.lbase!=0)) 103 #define col2vim(x) ((x) - (tclinfo.lbase!=0)) 104 105 106 #define VIMOUT ((ClientData)1) 107 #define VIMERR ((ClientData)2) 108 109 /* This appears to be new in Tcl 8.4. */ 110 #ifndef CONST84 111 # define CONST84 112 #endif 113 114 /* 115 * List of Tcl interpreters who reference a vim window or buffer. 116 * Each buffer and window has its own list in the w_tcl_ref or b_tcl_ref 117 * struct member. We need this because Tcl can create sub-interpreters with 118 * the "interp" command, and each interpreter can reference all windows and 119 * buffers. 120 */ 121 struct ref 122 { 123 struct ref *next; 124 125 Tcl_Interp *interp; 126 Tcl_Command cmd; /* Tcl command that represents this object */ 127 Tcl_Obj *delcmd; /* Tcl command to call when object is being del. */ 128 void *vimobj; /* Vim window or buffer (win_T* or buf_T*) */ 129 }; 130 static char * tclgetbuffer _ANSI_ARGS_((Tcl_Interp *interp, buf_T *buf)); 131 static char * tclgetwindow _ANSI_ARGS_((Tcl_Interp *interp, win_T *win)); 132 static int tclsetdelcmd _ANSI_ARGS_((Tcl_Interp *interp, struct ref *reflist, void *vimobj, Tcl_Obj *delcmd)); 133 static int tclgetlinenum _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *obj, int *valueP, buf_T *buf)); 134 static win_T *tclfindwin _ANSI_ARGS_ ((buf_T *buf)); 135 static int tcldoexcommand _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int objn)); 136 static int tclsetoption _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int objn)); 137 static int tclvimexpr _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int objn)); 138 static void tcldelthisinterp _ANSI_ARGS_ ((void)); 139 140 static int vimerror _ANSI_ARGS_((Tcl_Interp *interp)); 141 static void tclmsg _ANSI_ARGS_((char *text)); 142 static void tclerrmsg _ANSI_ARGS_((char *text)); 143 static void tclupdatevars _ANSI_ARGS_((void)); 144 145 static struct ref refsdeleted; /* dummy object for deleted ref list */ 146 147 /***************************************************************************** 148 * TCL interface manager 149 ****************************************************************************/ 150 151 #if defined(DYNAMIC_TCL) || defined(PROTO) 152 # ifndef DYNAMIC_TCL_DLL 153 # define DYNAMIC_TCL_DLL "tcl83.dll" 154 # endif 155 # ifndef DYNAMIC_TCL_VER 156 # define DYNAMIC_TCL_VER "8.3" 157 # endif 158 159 # ifndef DYNAMIC_TCL /* Just generating prototypes */ 160 typedef int HANDLE; 161 # endif 162 163 # ifndef WIN3264 164 # include <dlfcn.h> 165 # define HANDLE void* 166 # define TCL_PROC void* 167 # define load_dll(n) dlopen((n), RTLD_LAZY|RTLD_GLOBAL) 168 # define symbol_from_dll dlsym 169 # define close_dll dlclose 170 # else 171 # define TCL_PROC FARPROC 172 # define load_dll vimLoadLib 173 # define symbol_from_dll GetProcAddress 174 # define close_dll FreeLibrary 175 # endif 176 177 /* 178 * Declare HANDLE for tcl.dll and function pointers. 179 */ 180 static HANDLE hTclLib = NULL; 181 Tcl_Interp* (*dll_Tcl_CreateInterp)(); 182 void (*dll_Tcl_FindExecutable)(const void *); 183 184 /* 185 * Table of name to function pointer of tcl. 186 */ 187 static struct { 188 char* name; 189 TCL_PROC* ptr; 190 } tcl_funcname_table[] = { 191 {"Tcl_CreateInterp", (TCL_PROC*)&dll_Tcl_CreateInterp}, 192 {"Tcl_FindExecutable", (TCL_PROC*)&dll_Tcl_FindExecutable}, 193 {NULL, NULL}, 194 }; 195 196 /* 197 * Make all runtime-links of tcl. 198 * 199 * 1. Get module handle using LoadLibraryEx. 200 * 2. Get pointer to tcl function by GetProcAddress. 201 * 3. Repeat 2, until get all functions will be used. 202 * 203 * Parameter 'libname' provides name of DLL. 204 * Return OK or FAIL. 205 */ 206 static int 207 tcl_runtime_link_init(char *libname, int verbose) 208 { 209 int i; 210 211 if (hTclLib) 212 return OK; 213 if (!(hTclLib = load_dll(libname))) 214 { 215 if (verbose) 216 semsg(_(e_loadlib), libname); 217 return FAIL; 218 } 219 for (i = 0; tcl_funcname_table[i].ptr; ++i) 220 { 221 if (!(*tcl_funcname_table[i].ptr = symbol_from_dll(hTclLib, 222 tcl_funcname_table[i].name))) 223 { 224 close_dll(hTclLib); 225 hTclLib = NULL; 226 if (verbose) 227 semsg(_(e_loadfunc), tcl_funcname_table[i].name); 228 return FAIL; 229 } 230 } 231 return OK; 232 } 233 #endif /* defined(DYNAMIC_TCL) || defined(PROTO) */ 234 235 #ifdef DYNAMIC_TCL 236 static char *find_executable_arg = NULL; 237 #endif 238 239 void 240 vim_tcl_init(char *arg) 241 { 242 #ifndef DYNAMIC_TCL 243 Tcl_FindExecutable(arg); 244 #else 245 find_executable_arg = arg; 246 #endif 247 } 248 249 #if defined(DYNAMIC_TCL) || defined(PROTO) 250 251 static int stubs_initialized = FALSE; 252 253 /* 254 * Return TRUE if the TCL interface can be used. 255 */ 256 int 257 tcl_enabled(int verbose) 258 { 259 if (!stubs_initialized && find_executable_arg != NULL 260 && tcl_runtime_link_init((char *)p_tcldll, verbose) == OK) 261 { 262 Tcl_Interp *interp; 263 264 dll_Tcl_FindExecutable(find_executable_arg); 265 266 if ((interp = dll_Tcl_CreateInterp()) != NULL) 267 { 268 if (Tcl_InitStubs(interp, DYNAMIC_TCL_VER, 0)) 269 { 270 Tcl_DeleteInterp(interp); 271 stubs_initialized = TRUE; 272 } 273 /* FIXME: When Tcl_InitStubs() was failed, how delete interp? */ 274 } 275 } 276 return stubs_initialized; 277 } 278 #endif 279 280 void 281 tcl_end(void) 282 { 283 #ifdef DYNAMIC_TCL 284 if (hTclLib) 285 { 286 close_dll(hTclLib); 287 hTclLib = NULL; 288 } 289 #endif 290 } 291 292 /**************************************************************************** 293 Tcl commands 294 ****************************************************************************/ 295 296 /* 297 * Replace standard "exit" command. 298 * 299 * Delete the Tcl interpreter; a new one will be created with the next 300 * :tcl command). The exit code is saved (and retrieved in tclexit()). 301 * Since Tcl's exit is never expected to return and this replacement 302 * does, then (except for a trivial case) additional Tcl commands will 303 * be run. Since the interpreter is now marked as deleted, an error 304 * will be returned -- typically "attempt to call eval in deleted 305 * interpreter". Hopefully, at this point, checks for TCL_ERROR take 306 * place and control percolates back up to Vim -- but with this new error 307 * string in the interpreter's result value. Therefore it would be 308 * useless for this routine to return the exit code via Tcl_SetResult(). 309 */ 310 static int 311 exitcmd( 312 ClientData dummy UNUSED, 313 Tcl_Interp *interp, 314 int objc, 315 Tcl_Obj *CONST objv[]) 316 { 317 int value = 0; 318 319 switch (objc) 320 { 321 case 2: 322 if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) 323 break; 324 /* FALLTHROUGH */ 325 case 1: 326 tclinfo.exitvalue = value; 327 328 Tcl_DeleteInterp(interp); 329 break; 330 default: 331 Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?"); 332 } 333 return TCL_ERROR; 334 } 335 336 /* 337 * "::vim::beep" - what Vi[m] does best :-) 338 */ 339 static int 340 beepcmd( 341 ClientData dummy UNUSED, 342 Tcl_Interp *interp, 343 int objc, 344 Tcl_Obj *CONST objv[]) 345 { 346 if (objc != 1) 347 { 348 Tcl_WrongNumArgs(interp, 1, objv, NULL); 349 return TCL_ERROR; 350 } 351 vim_beep(BO_LANG); 352 return TCL_OK; 353 } 354 355 /* 356 * "::vim::buffer list" - create a list of buffer commands. 357 * "::vim::buffer {N}" - create buffer command for buffer N. 358 * "::vim::buffer exists {N}" - test if buffer N exists. 359 * "::vim::buffer new" - create a new buffer (not implemented) 360 */ 361 static int 362 buffercmd( 363 ClientData dummy UNUSED, 364 Tcl_Interp *interp, 365 int objc, 366 Tcl_Obj *CONST objv[]) 367 { 368 char *name; 369 buf_T *buf; 370 Tcl_Obj *resobj; 371 int err, n, idx; 372 enum {BCMD_EXISTS, BCMD_LIST}; 373 static CONST84 char *bcmdoptions[] = 374 { 375 "exists", "list", (char *)0 376 }; 377 378 if (objc < 2) 379 { 380 Tcl_WrongNumArgs(interp, 1, objv, "option"); 381 return TCL_ERROR; 382 } 383 err = Tcl_GetIntFromObj(interp, objv[1], &n); 384 if (err == TCL_OK) 385 { 386 if (objc != 2) 387 { 388 Tcl_WrongNumArgs(interp, 1, objv, "bufNumber"); 389 return TCL_ERROR; 390 } 391 FOR_ALL_BUFFERS(buf) 392 { 393 if (buf->b_fnum == n) 394 { 395 name = tclgetbuffer(interp, buf); 396 if (name == NULL) 397 return TCL_ERROR; 398 Tcl_SetResult(interp, name, TCL_VOLATILE); 399 return TCL_OK; 400 } 401 } 402 Tcl_SetResult(interp, _("invalid buffer number"), TCL_STATIC); 403 return TCL_ERROR; 404 } 405 Tcl_ResetResult(interp); /* clear error from Tcl_GetIntFromObj */ 406 407 err = Tcl_GetIndexFromObj(interp, objv[1], bcmdoptions, "option", 0, &idx); 408 if (err != TCL_OK) 409 return err; 410 switch (idx) 411 { 412 case BCMD_LIST: 413 if (objc != 2) 414 { 415 Tcl_WrongNumArgs(interp, 2, objv, ""); 416 err = TCL_ERROR; 417 break; 418 } 419 FOR_ALL_BUFFERS(buf) 420 { 421 name = tclgetbuffer(interp, buf); 422 if (name == NULL) 423 { 424 err = TCL_ERROR; 425 break; 426 } 427 Tcl_AppendElement(interp, name); 428 } 429 break; 430 431 case BCMD_EXISTS: 432 if (objc != 3) 433 { 434 Tcl_WrongNumArgs(interp, 2, objv, "bufNumber"); 435 err = TCL_ERROR; 436 break; 437 } 438 err = Tcl_GetIntFromObj(interp, objv[2], &n); 439 if (err == TCL_OK) 440 { 441 buf = buflist_findnr(n); 442 resobj = Tcl_NewIntObj(buf != NULL); 443 Tcl_SetObjResult(interp, resobj); 444 } 445 break; 446 447 default: 448 Tcl_SetResult(interp, _("not implemented yet"), TCL_STATIC); 449 err = TCL_ERROR; 450 } 451 return err; 452 } 453 454 /* 455 * "::vim::window list" - create list of window commands. 456 */ 457 static int 458 windowcmd( 459 ClientData dummy UNUSED, 460 Tcl_Interp *interp, 461 int objc, 462 Tcl_Obj *CONST objv[]) 463 { 464 char *what, *string; 465 win_T *win; 466 467 if (objc != 2) 468 { 469 Tcl_WrongNumArgs(interp, 1, objv, "option"); 470 return TCL_ERROR; 471 } 472 what = Tcl_GetStringFromObj(objv[1], NULL); 473 if (strcmp(what, "list") == 0) 474 { 475 FOR_ALL_WINDOWS(win) 476 { 477 string = tclgetwindow(interp, win); 478 if (string == NULL) 479 return TCL_ERROR; 480 Tcl_AppendElement(interp, string); 481 } 482 return TCL_OK; 483 } 484 Tcl_SetResult(interp, _("unknown option"), TCL_STATIC); 485 return TCL_ERROR; 486 } 487 488 /* 489 * flags for bufselfcmd and winselfcmd to indicate outstanding actions. 490 */ 491 #define FL_UPDATE_SCREEN (1<<0) 492 #define FL_UPDATE_CURBUF (1<<1) 493 #define FL_ADJUST_CURSOR (1<<2) 494 495 /* 496 * This function implements the buffer commands. 497 */ 498 static int 499 bufselfcmd( 500 ClientData ref, 501 Tcl_Interp *interp, 502 int objc, 503 Tcl_Obj *CONST objv[]) 504 { 505 int opt, err, idx, flags; 506 int val1, val2, n, i; 507 buf_T *buf, *savebuf; 508 win_T *win, *savewin; 509 Tcl_Obj *resobj; 510 pos_T *pos; 511 char *line; 512 513 enum 514 { 515 BUF_APPEND, BUF_COMMAND, BUF_COUNT, BUF_DELCMD, BUF_DELETE, BUF_EXPR, 516 BUF_GET, BUF_INSERT, BUF_LAST, BUF_MARK, BUF_NAME, BUF_NUMBER, 517 BUF_OPTION, BUF_SET, BUF_WINDOWS 518 }; 519 static CONST84 char *bufoptions[] = 520 { 521 "append", "command", "count", "delcmd", "delete", "expr", 522 "get", "insert", "last", "mark", "name", "number", 523 "option", "set", "windows", (char *)0 524 }; 525 526 if (objc < 2) 527 { 528 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); 529 return TCL_ERROR; 530 } 531 532 err = Tcl_GetIndexFromObj(interp, objv[1], bufoptions, "option", 0, &idx); 533 if (err != TCL_OK) 534 return err; 535 536 buf = (buf_T *)((struct ref *)ref)->vimobj; 537 savebuf = curbuf; curbuf = buf; 538 savewin = curwin; curwin = tclfindwin(buf); 539 flags = 0; 540 opt = 0; 541 542 switch (idx) 543 { 544 case BUF_COMMAND: 545 err = tcldoexcommand(interp, objc, objv, 2); 546 flags |= FL_UPDATE_SCREEN; 547 break; 548 549 case BUF_OPTION: 550 err = tclsetoption(interp, objc, objv, 2); 551 flags |= FL_UPDATE_SCREEN; 552 break; 553 554 case BUF_EXPR: 555 err = tclvimexpr(interp, objc, objv, 2); 556 break; 557 558 case BUF_NAME: 559 /* 560 * Get filename of buffer. 561 */ 562 if (objc != 2) 563 { 564 Tcl_WrongNumArgs(interp, 2, objv, NULL); 565 err = TCL_ERROR; 566 break; 567 } 568 if (buf->b_ffname) 569 Tcl_SetResult(interp, (char *)buf->b_ffname, TCL_VOLATILE); 570 else 571 Tcl_SetResult(interp, "", TCL_STATIC); 572 break; 573 574 case BUF_LAST: 575 /* 576 * Get line number of last line. 577 */ 578 opt = 1; 579 /* fallthrough */ 580 case BUF_COUNT: 581 /* 582 * Get number of lines in buffer. 583 */ 584 if (objc != 2) 585 { 586 Tcl_WrongNumArgs(interp, 2, objv, NULL); 587 err = TCL_ERROR; 588 break; 589 } 590 val1 = (int)buf->b_ml.ml_line_count; 591 if (opt) 592 val1 = row2tcl(val1); 593 594 resobj = Tcl_NewIntObj(val1); 595 Tcl_SetObjResult(interp, resobj); 596 break; 597 598 case BUF_NUMBER: 599 /* 600 * Get buffer's number. 601 */ 602 if (objc != 2) 603 { 604 Tcl_WrongNumArgs(interp, 2, objv, NULL); 605 err = TCL_ERROR; 606 break; 607 } 608 resobj = Tcl_NewIntObj((int)buf->b_fnum); 609 Tcl_SetObjResult(interp, resobj); 610 break; 611 612 case BUF_GET: 613 if (objc != 3 && objc != 4) 614 { 615 Tcl_WrongNumArgs(interp, 2, objv, "lineNumber ?lineNumber?"); 616 err = TCL_ERROR; 617 break; 618 } 619 err = tclgetlinenum(interp, objv[2], &val1, buf); 620 if (err != TCL_OK) 621 break; 622 if (objc == 4) 623 { 624 err = tclgetlinenum(interp, objv[3], &val2, buf); 625 if (err != TCL_OK) 626 break; 627 if (val1 > val2) 628 { 629 n = val1; val1 = val2; val2 = n; 630 } 631 Tcl_ResetResult(interp); 632 633 for (n = val1; n <= val2 && err == TCL_OK; n++) 634 { 635 line = (char *)ml_get_buf(buf, (linenr_T)n, FALSE); 636 if (line) 637 Tcl_AppendElement(interp, line); 638 else 639 err = TCL_ERROR; 640 } 641 } 642 else { /* objc == 3 */ 643 line = (char *)ml_get_buf(buf, (linenr_T)val1, FALSE); 644 Tcl_SetResult(interp, line, TCL_VOLATILE); 645 } 646 break; 647 648 case BUF_SET: 649 if (objc != 4 && objc != 5) 650 { 651 Tcl_WrongNumArgs(interp, 3, objv, "lineNumber ?lineNumber? stringOrList"); 652 err = TCL_ERROR; 653 break; 654 } 655 err = tclgetlinenum(interp, objv[2], &val1, buf); 656 if (err != TCL_OK) 657 return TCL_ERROR; 658 if (objc == 4) 659 { 660 /* 661 * Replace one line with a string. 662 * $buf set {n} {string} 663 */ 664 line = Tcl_GetStringFromObj(objv[3], NULL); 665 if (u_savesub((linenr_T)val1) != OK) 666 { 667 Tcl_SetResult(interp, _("cannot save undo information"), TCL_STATIC); 668 err = TCL_ERROR; 669 } 670 else 671 if (ml_replace((linenr_T)val1, (char_u *)line, TRUE) != OK) 672 { 673 Tcl_SetResult(interp, _("cannot replace line"), TCL_STATIC); 674 err = TCL_ERROR; 675 } 676 else 677 { 678 changed_bytes((linenr_T)val1, 0); 679 flags |= FL_UPDATE_CURBUF; 680 } 681 break; 682 } 683 else 684 { 685 /* 686 * Replace several lines with the elements of a Tcl list. 687 * $buf set {n} {m} {list} 688 * If the list contains more than {m}-{n}+1 elements, they 689 * are * inserted after line {m}. If the list contains fewer 690 * elements, * the lines from {n}+length({list}) through {m} 691 * are deleted. 692 */ 693 int lc; 694 Tcl_Obj **lv; 695 696 err = tclgetlinenum(interp, objv[3], &val2, buf); 697 if (err != TCL_OK) 698 break; 699 err = Tcl_ListObjGetElements(interp, objv[4], &lc, &lv); 700 if (err != TCL_OK) 701 break; 702 if (val1 > val2) 703 { 704 n = val1; 705 val1 = val2; 706 val2 = n; 707 } 708 709 n = val1; 710 if (u_save((linenr_T)(val1 - 1), (linenr_T)(val2 + 1)) != OK) 711 { 712 Tcl_SetResult(interp, _("cannot save undo information"), 713 TCL_STATIC); 714 err = TCL_ERROR; 715 break; 716 } 717 flags |= FL_UPDATE_CURBUF; 718 719 for (i = 0; i < lc && n <= val2; i++) 720 { 721 line = Tcl_GetStringFromObj(lv[i], NULL); 722 if (ml_replace((linenr_T)n, (char_u *)line, TRUE) != OK) 723 goto setListError; 724 ++n; 725 } 726 if (i < lc) 727 { 728 /* append lines */ 729 do 730 { 731 line = Tcl_GetStringFromObj(lv[i], NULL); 732 if (ml_append((linenr_T)(n - 1), 733 (char_u *)line, 0, FALSE) != OK) 734 goto setListError; 735 ++n; 736 ++i; 737 } while (i < lc); 738 } 739 else if (n <= val2) 740 { 741 /* did not replace all lines, delete */ 742 i = n; 743 do 744 { 745 if (ml_delete((linenr_T)i, FALSE) != OK) 746 goto setListError; 747 ++n; 748 } while (n <= val2); 749 } 750 lc -= val2 - val1 + 1; /* number of lines to be replaced */ 751 mark_adjust((linenr_T)val1, (linenr_T)val2, (long)MAXLNUM, 752 (long)lc); 753 changed_lines((linenr_T)val1, 0, (linenr_T)val2 + 1, (long)lc); 754 break; 755 setListError: 756 u_undo(1); /* ??? */ 757 Tcl_SetResult(interp, _("cannot set line(s)"), TCL_STATIC); 758 err = TCL_ERROR; 759 } 760 break; 761 762 case BUF_DELETE: 763 if (objc != 3 && objc != 4) 764 { 765 Tcl_WrongNumArgs(interp, 3, objv, "lineNumber ?lineNumber?"); 766 err = TCL_ERROR; 767 break; 768 } 769 err = tclgetlinenum(interp, objv[2], &val1, buf); 770 if (err != TCL_OK) 771 break; 772 val2 = val1; 773 if (objc == 4) 774 { 775 err = tclgetlinenum(interp, objv[3], &val2, buf); 776 if (err != TCL_OK) 777 return err; 778 if (val1 > val2) 779 { 780 i = val1; val1 = val2; val2 = i; 781 } 782 } 783 n = val2 - val1 + 1; 784 if (u_savedel((linenr_T)val1, (long)n) != OK) 785 { 786 Tcl_SetResult(interp, _("cannot save undo information"), 787 TCL_STATIC); 788 err = TCL_ERROR; 789 break; 790 } 791 for (i = 0; i < n; i++) 792 { 793 ml_delete((linenr_T)val1, FALSE); 794 err = vimerror(interp); 795 if (err != TCL_OK) 796 break; 797 } 798 if (i > 0) 799 deleted_lines_mark((linenr_T)val1, (long)i); 800 flags |= FL_ADJUST_CURSOR|FL_UPDATE_SCREEN; 801 break; 802 803 case BUF_MARK: 804 if (objc != 3) 805 { 806 Tcl_WrongNumArgs(interp, 2, objv, "markName"); 807 err = TCL_ERROR; 808 break; 809 } 810 line = Tcl_GetStringFromObj(objv[2], NULL); 811 812 pos = NULL; 813 if (line[0] != '\0' && line[1] == '\0') 814 { 815 pos = getmark(line[0], FALSE); 816 } 817 if (pos == NULL) 818 { 819 Tcl_SetResult(interp, _("invalid mark name"), TCL_STATIC); 820 err = TCL_ERROR; 821 break; 822 } 823 err = vimerror(interp); 824 if (err != TCL_OK) 825 break; 826 if (pos->lnum <= 0) 827 { 828 Tcl_SetResult(interp, _("mark not set"), TCL_STATIC); 829 err = TCL_ERROR; 830 } 831 else 832 { 833 char rbuf[64]; 834 835 sprintf(rbuf, _("row %d column %d"), 836 (int)row2tcl(pos->lnum), (int)col2tcl(pos->col)); 837 Tcl_SetResult(interp, rbuf, TCL_VOLATILE); 838 } 839 break; 840 841 case BUF_INSERT: 842 opt = 1; 843 /* fallthrough */ 844 case BUF_APPEND: 845 if (objc != 4) 846 { 847 Tcl_WrongNumArgs(interp, 2, objv, "lineNum text"); 848 err = TCL_ERROR; 849 break; 850 } 851 err = tclgetlinenum(interp, objv[2], &val1, buf); 852 if (err != TCL_OK) 853 break; 854 if (opt) 855 --val1; 856 if (u_save((linenr_T)val1, (linenr_T)(val1+1)) != OK) 857 { 858 Tcl_SetResult(interp, _("cannot save undo information"), 859 TCL_STATIC); 860 err = TCL_ERROR; 861 break; 862 } 863 864 line = Tcl_GetStringFromObj(objv[3], NULL); 865 if (ml_append((linenr_T)val1, (char_u *)line, 0, FALSE) != OK) 866 { 867 Tcl_SetResult(interp, _("cannot insert/append line"), 868 TCL_STATIC); 869 err = TCL_ERROR; 870 break; 871 } 872 appended_lines_mark((linenr_T)val1, 1L); 873 flags |= FL_UPDATE_SCREEN; 874 break; 875 876 case BUF_WINDOWS: 877 /* 878 * Return list of window commands. 879 */ 880 if (objc != 2) 881 { 882 Tcl_WrongNumArgs(interp, 2, objv, NULL); 883 err = TCL_ERROR; 884 break; 885 } 886 Tcl_ResetResult(interp); 887 FOR_ALL_WINDOWS(win) 888 { 889 if (win->w_buffer == buf) 890 { 891 line = tclgetwindow(interp, win); 892 if (line != NULL) 893 Tcl_AppendElement(interp, line); 894 else 895 { 896 err = TCL_ERROR; 897 break; 898 } 899 } 900 } 901 break; 902 903 case BUF_DELCMD: 904 /* 905 * Register deletion callback. 906 * TODO: Should be able to register multiple callbacks 907 */ 908 if (objc != 3) 909 { 910 Tcl_WrongNumArgs(interp, 2, objv, "command"); 911 err = TCL_ERROR; 912 break; 913 } 914 err = tclsetdelcmd(interp, buf->b_tcl_ref, (void *)buf, objv[2]); 915 break; 916 917 default: 918 Tcl_SetResult(interp, _("not implemented yet"), TCL_STATIC); 919 err = TCL_ERROR; 920 } 921 922 if (flags & FL_UPDATE_CURBUF) 923 redraw_curbuf_later(NOT_VALID); 924 curbuf = savebuf; 925 curwin = savewin; 926 if (flags & FL_ADJUST_CURSOR) 927 check_cursor(); 928 if (flags & (FL_UPDATE_SCREEN | FL_UPDATE_CURBUF)) 929 update_screen(NOT_VALID); 930 931 return err; 932 } 933 934 /* 935 * This function implements the window commands. 936 */ 937 static int 938 winselfcmd( 939 ClientData ref, 940 Tcl_Interp *interp, 941 int objc, 942 Tcl_Obj *CONST objv[]) 943 { 944 int err, idx, flags; 945 int val1, val2; 946 Tcl_Obj *resobj; 947 win_T *savewin, *win; 948 buf_T *savebuf; 949 char *str; 950 951 enum 952 { 953 WIN_BUFFER, WIN_COMMAND, WIN_CURSOR, WIN_DELCMD, WIN_EXPR, 954 WIN_HEIGHT, WIN_OPTION 955 }; 956 static CONST84 char *winoptions[] = 957 { 958 "buffer", "command", "cursor", "delcmd", "expr", 959 "height", "option", (char *)0 960 }; 961 962 if (objc < 2) 963 { 964 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); 965 return TCL_ERROR; 966 } 967 968 err = Tcl_GetIndexFromObj(interp, objv[1], winoptions, "option", 0, &idx); 969 if (err != TCL_OK) 970 return TCL_ERROR; 971 972 win = (win_T *)((struct ref *)ref)->vimobj; 973 savewin = curwin; curwin = win; 974 savebuf = curbuf; curbuf = win->w_buffer; 975 flags = 0; 976 977 switch (idx) 978 { 979 case WIN_OPTION: 980 err = tclsetoption(interp, objc, objv, 2); 981 flags |= FL_UPDATE_SCREEN; 982 break; 983 984 case WIN_COMMAND: 985 err = tcldoexcommand(interp, objc, objv, 2); 986 flags |= FL_UPDATE_SCREEN; 987 break; 988 989 case WIN_EXPR: 990 err = tclvimexpr(interp, objc, objv, 2); 991 break; 992 993 case WIN_HEIGHT: 994 if (objc == 3) 995 { 996 err = Tcl_GetIntFromObj(interp, objv[2], &val1); 997 if (err != TCL_OK) 998 break; 999 #ifdef FEAT_GUI 1000 need_mouse_correct = TRUE; 1001 #endif 1002 win_setheight(val1); 1003 err = vimerror(interp); 1004 if (err != TCL_OK) 1005 break; 1006 } 1007 else 1008 if (objc != 2) 1009 { 1010 Tcl_WrongNumArgs(interp, 2, objv, "?value?"); 1011 err = TCL_ERROR; 1012 break; 1013 } 1014 1015 resobj = Tcl_NewIntObj((int)(win->w_height)); 1016 Tcl_SetObjResult(interp, resobj); 1017 break; 1018 1019 case WIN_BUFFER: 1020 if (objc != 2) 1021 { 1022 Tcl_WrongNumArgs(interp, 2, objv, NULL); 1023 err = TCL_ERROR; 1024 break; 1025 } 1026 str = tclgetbuffer(interp, win->w_buffer); 1027 if (str) 1028 Tcl_SetResult(interp, str, TCL_VOLATILE); 1029 else 1030 err = TCL_ERROR; 1031 break; 1032 1033 case WIN_DELCMD: 1034 if (objc != 3) 1035 { 1036 Tcl_WrongNumArgs(interp, 2, objv, "command"); 1037 err = TCL_ERROR; 1038 break; 1039 } 1040 err = tclsetdelcmd(interp, win->w_tcl_ref, (void *)win, objv[2]); 1041 break; 1042 1043 case WIN_CURSOR: 1044 if (objc > 4) 1045 { 1046 Tcl_WrongNumArgs(interp, 2, objv, "?arg1 ?arg2??"); 1047 err = TCL_ERROR; 1048 break; 1049 } 1050 if (objc == 2) 1051 { 1052 char buf[64]; 1053 1054 sprintf(buf, _("row %d column %d"), (int)row2tcl(win->w_cursor.lnum), (int)col2tcl(win->w_cursor.col)); 1055 Tcl_SetResult(interp, buf, TCL_VOLATILE); 1056 break; 1057 } 1058 else if (objc == 3) 1059 { 1060 Tcl_Obj *part, *var; 1061 1062 part = Tcl_NewStringObj("row", -1); 1063 var = Tcl_ObjGetVar2(interp, objv[2], part, TCL_LEAVE_ERR_MSG); 1064 if (var == NULL) 1065 { 1066 err = TCL_ERROR; 1067 break; 1068 } 1069 err = tclgetlinenum(interp, var, &val1, win->w_buffer); 1070 if (err != TCL_OK) 1071 break; 1072 part = Tcl_NewStringObj("column", -1); 1073 var = Tcl_ObjGetVar2(interp, objv[2], part, TCL_LEAVE_ERR_MSG); 1074 if (var == NULL) 1075 { 1076 err = TCL_ERROR; 1077 break; 1078 } 1079 err = Tcl_GetIntFromObj(interp, var, &val2); 1080 if (err != TCL_OK) 1081 break; 1082 } 1083 else { /* objc == 4 */ 1084 err = tclgetlinenum(interp, objv[2], &val1, win->w_buffer); 1085 if (err != TCL_OK) 1086 break; 1087 err = Tcl_GetIntFromObj(interp, objv[3], &val2); 1088 if (err != TCL_OK) 1089 break; 1090 } 1091 /* TODO: should check column */ 1092 win->w_cursor.lnum = val1; 1093 win->w_cursor.col = col2vim(val2); 1094 win->w_set_curswant = TRUE; 1095 flags |= FL_UPDATE_SCREEN; 1096 break; 1097 1098 default: 1099 Tcl_SetResult(interp, _("not implemented yet"), TCL_STATIC); 1100 break; 1101 } 1102 1103 curwin = savewin; 1104 curbuf = savebuf; 1105 if (flags & FL_UPDATE_SCREEN) 1106 update_screen(NOT_VALID); 1107 1108 return err; 1109 } 1110 1111 1112 static int 1113 commandcmd( 1114 ClientData dummy UNUSED, 1115 Tcl_Interp *interp, 1116 int objc, 1117 Tcl_Obj *CONST objv[]) 1118 { 1119 int err; 1120 1121 err = tcldoexcommand(interp, objc, objv, 1); 1122 update_screen(VALID); 1123 return err; 1124 } 1125 1126 static int 1127 optioncmd( 1128 ClientData dummy UNUSED, 1129 Tcl_Interp *interp, 1130 int objc, 1131 Tcl_Obj *CONST objv[]) 1132 { 1133 int err; 1134 1135 err = tclsetoption(interp, objc, objv, 1); 1136 update_screen(VALID); 1137 return err; 1138 } 1139 1140 static int 1141 exprcmd( 1142 ClientData dummy UNUSED, 1143 Tcl_Interp *interp, 1144 int objc, 1145 Tcl_Obj *CONST objv[]) 1146 { 1147 return tclvimexpr(interp, objc, objv, 1); 1148 } 1149 1150 /**************************************************************************** 1151 Support functions for Tcl commands 1152 ****************************************************************************/ 1153 1154 /* 1155 * Get a line number from 'obj' and convert it to vim's range. 1156 */ 1157 static int 1158 tclgetlinenum( 1159 Tcl_Interp *interp, 1160 Tcl_Obj *obj, 1161 int *valueP, 1162 buf_T *buf) 1163 { 1164 int err, i; 1165 1166 enum { LN_BEGIN, LN_BOTTOM, LN_END, LN_FIRST, LN_LAST, LN_START, LN_TOP }; 1167 1168 static CONST84 char *keyw[] = 1169 { 1170 "begin", "bottom", "end", "first", "last", "start", "top", (char *)0 1171 }; 1172 1173 err = Tcl_GetIndexFromObj(interp, obj, keyw, "", 0, &i); 1174 if (err == TCL_OK) 1175 { 1176 switch (i) 1177 { 1178 case LN_BEGIN: 1179 case LN_FIRST: 1180 case LN_START: 1181 case LN_TOP: 1182 *valueP = 1; 1183 break; 1184 case LN_BOTTOM: 1185 case LN_END: 1186 case LN_LAST: 1187 *valueP = buf->b_ml.ml_line_count; 1188 break; 1189 } 1190 return TCL_OK; 1191 } 1192 Tcl_ResetResult(interp); 1193 1194 err = Tcl_GetIntFromObj(interp, obj, &i); 1195 if (err != TCL_OK) 1196 return err; 1197 i = row2vim(i); 1198 if (i < 1 || i > buf->b_ml.ml_line_count) 1199 { 1200 Tcl_SetResult(interp, _("line number out of range"), TCL_STATIC); 1201 return TCL_ERROR; 1202 } 1203 *valueP = i; 1204 return TCL_OK; 1205 } 1206 1207 /* 1208 * Find the first window in the window list that displays the buffer. 1209 */ 1210 static win_T * 1211 tclfindwin(buf_T *buf) 1212 { 1213 win_T *win; 1214 1215 FOR_ALL_WINDOWS(win) 1216 { 1217 if (win->w_buffer == buf) 1218 return win; 1219 } 1220 return curwin; /* keep current window context */ 1221 } 1222 1223 /* 1224 * Do-it-all function for "::vim::command", "$buf command" and "$win command". 1225 */ 1226 static int 1227 tcldoexcommand( 1228 Tcl_Interp *interp, 1229 int objc, 1230 Tcl_Obj *CONST objv[], 1231 int objn) 1232 { 1233 tcl_info saveinfo; 1234 int err, flag, nobjs; 1235 char *arg; 1236 1237 nobjs = objc - objn; 1238 if (nobjs < 1 || nobjs > 2) 1239 { 1240 Tcl_WrongNumArgs(interp, objn, objv, "?-quiet? exCommand"); 1241 return TCL_ERROR; 1242 } 1243 1244 flag = 0; 1245 if (nobjs == 2) 1246 { 1247 arg = Tcl_GetStringFromObj(objv[objn], NULL); 1248 if (strcmp(arg, "-quiet") == 0) 1249 flag = 1; 1250 else 1251 { 1252 Tcl_ResetResult(interp); 1253 Tcl_AppendResult(interp, _("unknown flag: "), arg, (char *)0); 1254 return TCL_ERROR; 1255 } 1256 ++objn; 1257 } 1258 1259 memcpy(&saveinfo, &tclinfo, sizeof(tcl_info)); 1260 tclinfo.interp = NULL; 1261 tclinfo.curwin = NULL; 1262 tclinfo.curbuf = NULL; 1263 1264 arg = Tcl_GetStringFromObj(objv[objn], NULL); 1265 if (flag) 1266 ++emsg_off; 1267 do_cmdline_cmd((char_u *)arg); 1268 if (flag) 1269 --emsg_off; 1270 err = vimerror(interp); 1271 1272 /* If the ex command created a new Tcl interpreter, remove it */ 1273 if (tclinfo.interp) 1274 tcldelthisinterp(); 1275 memcpy(&tclinfo, &saveinfo, sizeof(tcl_info)); 1276 tclupdatevars(); 1277 1278 return err; 1279 } 1280 1281 /* 1282 * Do-it-all function for "::vim::option", "$buf option" and "$win option". 1283 */ 1284 static int 1285 tclsetoption( 1286 Tcl_Interp *interp, 1287 int objc, 1288 Tcl_Obj *CONST objv[], 1289 int objn) 1290 { 1291 int err, nobjs, idx; 1292 char_u *option; 1293 int isnum; 1294 long lval; 1295 char_u *sval; 1296 Tcl_Obj *resobj; 1297 1298 enum { OPT_OFF, OPT_ON, OPT_TOGGLE }; 1299 static CONST84 char *optkw[] = { "off", "on", "toggle", (char *)0 }; 1300 1301 nobjs = objc - objn; 1302 if (nobjs != 1 && nobjs != 2) 1303 { 1304 Tcl_WrongNumArgs(interp, objn, objv, "vimOption ?value?"); 1305 return TCL_ERROR; 1306 } 1307 1308 option = (char_u *)Tcl_GetStringFromObj(objv[objn], NULL); 1309 ++objn; 1310 isnum = get_option_value(option, &lval, &sval, 0); 1311 err = TCL_OK; 1312 switch (isnum) 1313 { 1314 case 0: 1315 Tcl_SetResult(interp, (char *)sval, TCL_VOLATILE); 1316 vim_free(sval); 1317 break; 1318 case 1: 1319 resobj = Tcl_NewLongObj(lval); 1320 Tcl_SetObjResult(interp, resobj); 1321 break; 1322 default: 1323 Tcl_SetResult(interp, _("unknown vimOption"), TCL_STATIC); 1324 return TCL_ERROR; 1325 } 1326 if (nobjs == 2) 1327 { 1328 if (isnum) 1329 { 1330 sval = NULL; /* avoid compiler warning */ 1331 err = Tcl_GetIndexFromObj(interp, objv[objn], optkw, "", 0, &idx); 1332 if (err != TCL_OK) 1333 { 1334 Tcl_ResetResult(interp); 1335 err = Tcl_GetLongFromObj(interp, objv[objn], &lval); 1336 } 1337 else 1338 switch (idx) 1339 { 1340 case OPT_ON: 1341 lval = 1; 1342 break; 1343 case OPT_OFF: 1344 lval = 0; 1345 break; 1346 case OPT_TOGGLE: 1347 lval = !lval; 1348 break; 1349 } 1350 } 1351 else 1352 sval = (char_u *)Tcl_GetStringFromObj(objv[objn], NULL); 1353 if (err == TCL_OK) 1354 { 1355 set_option_value(option, lval, sval, OPT_LOCAL); 1356 err = vimerror(interp); 1357 } 1358 } 1359 return err; 1360 } 1361 1362 /* 1363 * Do-it-all function for "::vim::expr", "$buf expr" and "$win expr". 1364 */ 1365 static int 1366 tclvimexpr( 1367 Tcl_Interp *interp, 1368 int objc, 1369 Tcl_Obj *CONST objv[], 1370 int objn) 1371 { 1372 #ifdef FEAT_EVAL 1373 char *expr, *str; 1374 #endif 1375 int err; 1376 1377 if (objc - objn != 1) 1378 { 1379 Tcl_WrongNumArgs(interp, objn, objv, "vimExpr"); 1380 return TCL_ERROR; 1381 } 1382 1383 #ifdef FEAT_EVAL 1384 expr = Tcl_GetStringFromObj(objv[objn], NULL); 1385 str = (char *)eval_to_string((char_u *)expr, NULL, TRUE); 1386 if (str == NULL) 1387 Tcl_SetResult(interp, _("invalid expression"), TCL_STATIC); 1388 else 1389 { 1390 Tcl_SetResult(interp, str, TCL_VOLATILE); 1391 vim_free(str); 1392 } 1393 err = vimerror(interp); 1394 #else 1395 Tcl_SetResult(interp, _("expressions disabled at compile time"), TCL_STATIC); 1396 err = TCL_ERROR; 1397 #endif 1398 1399 return err; 1400 } 1401 1402 /* 1403 * Check for internal vim errors. 1404 */ 1405 static int 1406 vimerror(Tcl_Interp *interp) 1407 { 1408 if (got_int) 1409 { 1410 Tcl_SetResult(interp, _("keyboard interrupt"), TCL_STATIC); 1411 return TCL_ERROR; 1412 } 1413 else if (did_emsg) 1414 { 1415 Tcl_SetResult(interp, _("vim error"), TCL_STATIC); 1416 return TCL_ERROR; 1417 } 1418 return TCL_OK; 1419 } 1420 1421 /* 1422 * Functions that handle the reference lists: 1423 * delref() - callback for Tcl's DeleteCommand 1424 * tclgetref() - find/create Tcl command for a win_T* or buf_T* object 1425 * tclgetwindow() - window frontend for tclgetref() 1426 * tclgetbuffer() - buffer frontend for tclgetref() 1427 * tclsetdelcmd() - add Tcl callback command to a vim object 1428 */ 1429 static void 1430 delref(ClientData cref) 1431 { 1432 struct ref *ref = (struct ref *)cref; 1433 1434 if (ref->delcmd) 1435 { 1436 Tcl_DecrRefCount(ref->delcmd); 1437 ref->delcmd = NULL; 1438 } 1439 ref->interp = NULL; 1440 } 1441 1442 static char * 1443 tclgetref( 1444 Tcl_Interp *interp, 1445 void **refstartP, /* ptr to w_tcl_ref/b_tcl-ref member of 1446 win_T/buf_T struct */ 1447 char *prefix, /* "win" or "buf" */ 1448 void *vimobj, /* win_T* or buf_T* */ 1449 Tcl_ObjCmdProc *proc) /* winselfcmd or bufselfcmd */ 1450 { 1451 struct ref *ref, *unused = NULL; 1452 static char name[VARNAME_SIZE]; 1453 Tcl_Command cmd; 1454 1455 ref = (struct ref *)(*refstartP); 1456 if (ref == &refsdeleted) 1457 { 1458 Tcl_SetResult(interp, _("cannot create buffer/window command: object is being deleted"), TCL_STATIC); 1459 return NULL; 1460 } 1461 1462 while (ref != NULL) 1463 { 1464 if (ref->interp == interp) 1465 break; 1466 if (ref->interp == NULL) 1467 unused = ref; 1468 ref = ref->next; 1469 } 1470 1471 if (ref) 1472 vim_snprintf(name, sizeof(name), "::vim::%s", 1473 Tcl_GetCommandName(interp, ref->cmd)); 1474 else 1475 { 1476 if (unused) 1477 ref = unused; 1478 else 1479 { 1480 ref = (struct ref *)Tcl_Alloc(sizeof(struct ref)); 1481 ref->interp = NULL; 1482 ref->next = (struct ref *)(*refstartP); 1483 (*refstartP) = (void *)ref; 1484 } 1485 1486 /* This might break on some exotic systems... */ 1487 vim_snprintf(name, sizeof(name), "::vim::%s_%lx", 1488 prefix, (unsigned long)vimobj); 1489 cmd = Tcl_CreateObjCommand(interp, name, proc, 1490 (ClientData)ref, (Tcl_CmdDeleteProc *)delref); 1491 if (!cmd) 1492 return NULL; 1493 1494 ref->interp = interp; 1495 ref->cmd = cmd; 1496 ref->delcmd = NULL; 1497 ref->vimobj = vimobj; 1498 } 1499 return name; 1500 } 1501 1502 static char * 1503 tclgetwindow(Tcl_Interp *interp, win_T *win) 1504 { 1505 return tclgetref(interp, &(win->w_tcl_ref), "win", (void *)win, winselfcmd); 1506 } 1507 1508 static char * 1509 tclgetbuffer(Tcl_Interp *interp, buf_T *buf) 1510 { 1511 return tclgetref(interp, &(buf->b_tcl_ref), "buf", (void *)buf, bufselfcmd); 1512 } 1513 1514 static int 1515 tclsetdelcmd( 1516 Tcl_Interp *interp, 1517 struct ref *reflist, 1518 void *vimobj, 1519 Tcl_Obj *delcmd) 1520 { 1521 if (reflist == &refsdeleted) 1522 { 1523 Tcl_SetResult(interp, _("cannot register callback command: buffer/window is already being deleted"), TCL_STATIC); 1524 return TCL_ERROR; 1525 } 1526 1527 while (reflist != NULL) 1528 { 1529 if (reflist->interp == interp && reflist->vimobj == vimobj) 1530 { 1531 if (reflist->delcmd) 1532 { 1533 Tcl_DecrRefCount(reflist->delcmd); 1534 } 1535 Tcl_IncrRefCount(delcmd); 1536 reflist->delcmd = delcmd; 1537 return TCL_OK; 1538 } 1539 reflist = reflist->next; 1540 } 1541 /* This should never happen. Famous last word? */ 1542 emsg(_("E280: TCL FATAL ERROR: reflist corrupt!? Please report this to [email protected]")); 1543 Tcl_SetResult(interp, _("cannot register callback command: buffer/window reference not found"), TCL_STATIC); 1544 return TCL_ERROR; 1545 } 1546 1547 1548 /******************************************* 1549 I/O Channel 1550 ********************************************/ 1551 1552 static int 1553 tcl_channel_close(ClientData instance, Tcl_Interp *interp UNUSED) 1554 { 1555 int err = 0; 1556 1557 /* currently does nothing */ 1558 1559 if (instance != VIMOUT && instance != VIMERR) 1560 { 1561 Tcl_SetErrno(EBADF); 1562 err = EBADF; 1563 } 1564 return err; 1565 } 1566 1567 static int 1568 tcl_channel_input( 1569 ClientData instance UNUSED, 1570 char *buf UNUSED, 1571 int bufsiz UNUSED, 1572 int *errptr) 1573 { 1574 1575 /* input is currently not supported */ 1576 1577 Tcl_SetErrno(EINVAL); 1578 if (errptr) 1579 *errptr = EINVAL; 1580 return -1; 1581 } 1582 1583 static int 1584 tcl_channel_output( 1585 ClientData instance, 1586 const char *buf, 1587 int bufsiz, 1588 int *errptr) 1589 { 1590 char_u *str; 1591 int result; 1592 1593 /* The buffer is not guaranteed to be 0-terminated, and we don't if 1594 * there is enough room to add a '\0'. So we have to create a copy 1595 * of the buffer... 1596 */ 1597 str = vim_strnsave((char_u *)buf, bufsiz); 1598 if (!str) 1599 { 1600 Tcl_SetErrno(ENOMEM); 1601 if (errptr) 1602 *errptr = ENOMEM; 1603 return -1; 1604 } 1605 1606 result = bufsiz; 1607 if (instance == VIMOUT) 1608 tclmsg((char *)str); 1609 else 1610 if (instance == VIMERR) 1611 tclerrmsg((char *)str); 1612 else 1613 { 1614 Tcl_SetErrno(EBADF); 1615 if (errptr) 1616 *errptr = EBADF; 1617 result = -1; 1618 } 1619 vim_free(str); 1620 return result; 1621 } 1622 1623 static void 1624 tcl_channel_watch(ClientData instance UNUSED, int mask UNUSED) 1625 { 1626 Tcl_SetErrno(EINVAL); 1627 } 1628 1629 static int 1630 tcl_channel_gethandle( 1631 ClientData instance UNUSED, 1632 int direction UNUSED, 1633 ClientData *handleptr UNUSED) 1634 { 1635 Tcl_SetErrno(EINVAL); 1636 return EINVAL; 1637 } 1638 1639 1640 static Tcl_ChannelType tcl_channel_type = 1641 { 1642 "vimmessage", /* typeName */ 1643 TCL_CHANNEL_VERSION_2, /* version */ 1644 tcl_channel_close, /* closeProc */ 1645 tcl_channel_input, /* inputProc */ 1646 tcl_channel_output, /* outputProc */ 1647 NULL, /* seekProc */ 1648 NULL, /* setOptionProc */ 1649 NULL, /* getOptionProc */ 1650 tcl_channel_watch, /* watchProc */ 1651 tcl_channel_gethandle, /* getHandleProc */ 1652 NULL, /* close2Proc */ 1653 NULL, /* blockModeProc */ 1654 #ifdef TCL_CHANNEL_VERSION_2 1655 NULL, /* flushProc */ 1656 NULL, /* handlerProc */ 1657 #endif 1658 /* The following should not be necessary since TCL_CHANNEL_VERSION_2 was 1659 * set above */ 1660 #ifdef TCL_CHANNEL_VERSION_3 1661 NULL, /* wideSeekProc */ 1662 #endif 1663 #ifdef TCL_CHANNEL_VERSION_4 1664 NULL, /* threadActionProc */ 1665 #endif 1666 #ifdef TCL_CHANNEL_VERSION_5 1667 NULL /* truncateProc */ 1668 #endif 1669 }; 1670 1671 /********************************** 1672 Interface to vim 1673 **********************************/ 1674 1675 static void 1676 tclupdatevars(void) 1677 { 1678 char varname[VARNAME_SIZE]; /* must be writeable */ 1679 char *name; 1680 1681 strcpy(varname, VAR_RANGE1); 1682 Tcl_UpdateLinkedVar(tclinfo.interp, varname); 1683 strcpy(varname, VAR_RANGE2); 1684 Tcl_UpdateLinkedVar(tclinfo.interp, varname); 1685 strcpy(varname, VAR_RANGE3); 1686 Tcl_UpdateLinkedVar(tclinfo.interp, varname); 1687 1688 strcpy(varname, VAR_LBASE); 1689 Tcl_UpdateLinkedVar(tclinfo.interp, varname); 1690 1691 name = tclgetbuffer(tclinfo.interp, curbuf); 1692 strcpy(tclinfo.curbuf, name); 1693 strcpy(varname, VAR_CURBUF); 1694 Tcl_UpdateLinkedVar(tclinfo.interp, varname); 1695 1696 name = tclgetwindow(tclinfo.interp, curwin); 1697 strcpy(tclinfo.curwin, name); 1698 strcpy(varname, VAR_CURWIN); 1699 Tcl_UpdateLinkedVar(tclinfo.interp, varname); 1700 } 1701 1702 1703 static int 1704 tclinit(exarg_T *eap) 1705 { 1706 char varname[VARNAME_SIZE]; /* Tcl_LinkVar requires writeable varname */ 1707 char *name; 1708 1709 #ifdef DYNAMIC_TCL 1710 if (!tcl_enabled(TRUE)) 1711 { 1712 emsg(_("E571: Sorry, this command is disabled: the Tcl library could not be loaded.")); 1713 return FAIL; 1714 } 1715 #endif 1716 1717 if (!tclinfo.interp) 1718 { 1719 Tcl_Interp *interp; 1720 static Tcl_Channel ch1, ch2; 1721 1722 /* Create replacement channels for stdout and stderr; this has to be 1723 * done each time an interpreter is created since the channels are closed 1724 * when the interpreter is deleted */ 1725 ch1 = Tcl_CreateChannel(&tcl_channel_type, "vimout", VIMOUT, TCL_WRITABLE); 1726 ch2 = Tcl_CreateChannel(&tcl_channel_type, "vimerr", VIMERR, TCL_WRITABLE); 1727 Tcl_SetStdChannel(ch1, TCL_STDOUT); 1728 Tcl_SetStdChannel(ch2, TCL_STDERR); 1729 1730 interp = Tcl_CreateInterp(); 1731 Tcl_Preserve(interp); 1732 if (Tcl_Init(interp) == TCL_ERROR) 1733 { 1734 Tcl_Release(interp); 1735 Tcl_DeleteInterp(interp); 1736 return FAIL; 1737 } 1738 #if 0 1739 /* VIM sure is interactive */ 1740 Tcl_SetVar(interp, "tcl_interactive", "1", TCL_GLOBAL_ONLY); 1741 #endif 1742 1743 Tcl_SetChannelOption(interp, ch1, "-buffering", "line"); 1744 #ifdef WIN3264 1745 Tcl_SetChannelOption(interp, ch1, "-translation", "lf"); 1746 #endif 1747 Tcl_SetChannelOption(interp, ch2, "-buffering", "line"); 1748 #ifdef WIN3264 1749 Tcl_SetChannelOption(interp, ch2, "-translation", "lf"); 1750 #endif 1751 1752 /* replace standard Tcl exit command */ 1753 Tcl_DeleteCommand(interp, "exit"); 1754 Tcl_CreateObjCommand(interp, "exit", exitcmd, 1755 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); 1756 1757 /* new commands, in ::vim namespace */ 1758 Tcl_CreateObjCommand(interp, "::vim::buffer", buffercmd, 1759 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); 1760 Tcl_CreateObjCommand(interp, "::vim::window", windowcmd, 1761 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); 1762 Tcl_CreateObjCommand(interp, "::vim::command", commandcmd, 1763 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); 1764 Tcl_CreateObjCommand(interp, "::vim::beep", beepcmd, 1765 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); 1766 Tcl_CreateObjCommand(interp, "::vim::option", optioncmd, 1767 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); 1768 Tcl_CreateObjCommand(interp, "::vim::expr", exprcmd, 1769 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); 1770 1771 /* "lbase" variable */ 1772 tclinfo.lbase = 1; 1773 strcpy(varname, VAR_LBASE); 1774 Tcl_LinkVar(interp, varname, (char *)&tclinfo.lbase, TCL_LINK_INT); 1775 1776 /* "range" variable */ 1777 tclinfo.range_start = eap->line1; 1778 strcpy(varname, VAR_RANGE1); 1779 Tcl_LinkVar(interp, varname, (char *)&tclinfo.range_start, TCL_LINK_INT|TCL_LINK_READ_ONLY); 1780 strcpy(varname, VAR_RANGE2); 1781 Tcl_LinkVar(interp, varname, (char *)&tclinfo.range_start, TCL_LINK_INT|TCL_LINK_READ_ONLY); 1782 tclinfo.range_end = eap->line2; 1783 strcpy(varname, VAR_RANGE3); 1784 Tcl_LinkVar(interp, varname, (char *)&tclinfo.range_end, TCL_LINK_INT|TCL_LINK_READ_ONLY); 1785 1786 /* "current" variable */ 1787 tclinfo.curbuf = Tcl_Alloc(VARNAME_SIZE); 1788 tclinfo.curwin = Tcl_Alloc(VARNAME_SIZE); 1789 name = tclgetbuffer(interp, curbuf); 1790 strcpy(tclinfo.curbuf, name); 1791 strcpy(varname, VAR_CURBUF); 1792 Tcl_LinkVar(interp, varname, (char *)&tclinfo.curbuf, TCL_LINK_STRING|TCL_LINK_READ_ONLY); 1793 name = tclgetwindow(interp, curwin); 1794 strcpy(tclinfo.curwin, name); 1795 strcpy(varname, VAR_CURWIN); 1796 Tcl_LinkVar(interp, varname, (char *)&tclinfo.curwin, TCL_LINK_STRING|TCL_LINK_READ_ONLY); 1797 1798 tclinfo.interp = interp; 1799 } 1800 else 1801 { 1802 /* Interpreter already exists, just update variables */ 1803 tclinfo.range_start = row2tcl(eap->line1); 1804 tclinfo.range_end = row2tcl(eap->line2); 1805 tclupdatevars(); 1806 } 1807 1808 tclinfo.exitvalue = 0; 1809 return OK; 1810 } 1811 1812 static void 1813 tclerrmsg(char *text) 1814 { 1815 char *next; 1816 1817 while ((next=strchr(text, '\n'))) 1818 { 1819 *next++ = '\0'; 1820 emsg(text); 1821 text = next; 1822 } 1823 if (*text) 1824 emsg(text); 1825 } 1826 1827 static void 1828 tclmsg(char *text) 1829 { 1830 char *next; 1831 1832 while ((next=strchr(text, '\n'))) 1833 { 1834 *next++ = '\0'; 1835 msg(text); 1836 text = next; 1837 } 1838 if (*text) 1839 msg(text); 1840 } 1841 1842 static void 1843 tcldelthisinterp(void) 1844 { 1845 if (!Tcl_InterpDeleted(tclinfo.interp)) 1846 Tcl_DeleteInterp(tclinfo.interp); 1847 Tcl_Release(tclinfo.interp); 1848 /* The interpreter is now gets deleted. All registered commands (esp. 1849 * window and buffer commands) are deleted, triggering their deletion 1850 * callback, which deletes all refs pointing to this interpreter. 1851 * We could garbage-collect the unused ref structs in all windows and 1852 * buffers, but unless the user creates hundreds of sub-interpreters 1853 * all referring to lots of windows and buffers, this is hardly worth 1854 * the effort. Unused refs are recycled by other interpreters, and 1855 * all refs are free'd when the window/buffer gets closed by vim. 1856 */ 1857 1858 tclinfo.interp = NULL; 1859 Tcl_Free(tclinfo.curbuf); 1860 Tcl_Free(tclinfo.curwin); 1861 tclinfo.curbuf = tclinfo.curwin = NULL; 1862 } 1863 1864 static int 1865 tclexit(int error) 1866 { 1867 int newerr = OK; 1868 1869 if (Tcl_InterpDeleted(tclinfo.interp) /* True if we intercepted Tcl's exit command */ 1870 #if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 5) || TCL_MAJOR_VERSION > 8 1871 || Tcl_LimitExceeded(tclinfo.interp) /* True if the interpreter cannot continue */ 1872 #endif 1873 ) 1874 { 1875 char buf[50]; 1876 1877 sprintf(buf, _("E572: exit code %d"), tclinfo.exitvalue); 1878 tclerrmsg(buf); 1879 if (tclinfo.exitvalue == 0) 1880 { 1881 did_emsg = 0; 1882 newerr = OK; 1883 } 1884 else 1885 newerr = FAIL; 1886 1887 tcldelthisinterp(); 1888 } 1889 else 1890 { 1891 char *result; 1892 1893 result = (char *)Tcl_GetStringResult(tclinfo.interp); 1894 if (error == TCL_OK) 1895 { 1896 tclmsg(result); 1897 newerr = OK; 1898 } 1899 else 1900 { 1901 tclerrmsg(result); 1902 newerr = FAIL; 1903 } 1904 } 1905 1906 return newerr; 1907 } 1908 1909 /* 1910 * ":tcl" 1911 */ 1912 void 1913 ex_tcl(exarg_T *eap) 1914 { 1915 char_u *script; 1916 int err; 1917 1918 script = script_get(eap, eap->arg); 1919 if (!eap->skip) 1920 { 1921 err = tclinit(eap); 1922 if (err == OK) 1923 { 1924 Tcl_AllowExceptions(tclinfo.interp); 1925 if (script == NULL) 1926 err = Tcl_Eval(tclinfo.interp, (char *)eap->arg); 1927 else 1928 err = Tcl_Eval(tclinfo.interp, (char *)script); 1929 err = tclexit(err); 1930 } 1931 } 1932 vim_free(script); 1933 } 1934 1935 /* 1936 * ":tclfile" 1937 */ 1938 void 1939 ex_tclfile(exarg_T *eap) 1940 { 1941 char *file = (char *)eap->arg; 1942 int err; 1943 1944 err = tclinit(eap); 1945 if (err == OK) 1946 { 1947 Tcl_AllowExceptions(tclinfo.interp); 1948 err = Tcl_EvalFile(tclinfo.interp, file); 1949 err = tclexit(err); 1950 } 1951 } 1952 1953 /* 1954 * ":tcldo" 1955 */ 1956 void 1957 ex_tcldo(exarg_T *eap) 1958 { 1959 char *script, *line; 1960 int err, rs, re, lnum; 1961 char var_lnum[VARNAME_SIZE]; /* must be writeable memory */ 1962 char var_line[VARNAME_SIZE]; 1963 linenr_T first_line = 0; 1964 linenr_T last_line = 0; 1965 buf_T *was_curbuf = curbuf; 1966 1967 rs = eap->line1; 1968 re = eap->line2; 1969 script = (char *)eap->arg; 1970 strcpy(var_lnum, VAR_CURLNUM); 1971 strcpy(var_line, VAR_CURLINE); 1972 1973 err = tclinit(eap); 1974 if (err != OK) 1975 return; 1976 1977 lnum = row2tcl(rs); 1978 Tcl_LinkVar(tclinfo.interp, var_lnum, (char *)&lnum, TCL_LINK_INT|TCL_LINK_READ_ONLY); 1979 err = TCL_OK; 1980 if (u_save((linenr_T)(rs-1), (linenr_T)(re+1)) != OK) 1981 { 1982 Tcl_SetResult(tclinfo.interp, _("cannot save undo information"), TCL_STATIC); 1983 err = TCL_ERROR; 1984 } 1985 while (err == TCL_OK && rs <= re) 1986 { 1987 if ((linenr_T)rs > curbuf->b_ml.ml_line_count) 1988 break; 1989 line = (char *)ml_get_buf(curbuf, (linenr_T)rs, FALSE); 1990 if (!line) 1991 { 1992 Tcl_SetResult(tclinfo.interp, _("cannot get line"), TCL_STATIC); 1993 err = TCL_ERROR; 1994 break; 1995 } 1996 Tcl_SetVar(tclinfo.interp, var_line, line, 0); 1997 Tcl_AllowExceptions(tclinfo.interp); 1998 err = Tcl_Eval(tclinfo.interp, script); 1999 if (err != TCL_OK 2000 || Tcl_InterpDeleted(tclinfo.interp) 2001 #if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 5) || TCL_MAJOR_VERSION > 8 2002 || Tcl_LimitExceeded(tclinfo.interp) 2003 #endif 2004 || curbuf != was_curbuf) 2005 break; 2006 line = (char *)Tcl_GetVar(tclinfo.interp, var_line, 0); 2007 if (line) 2008 { 2009 if (ml_replace((linenr_T)rs, (char_u *)line, TRUE) != OK) 2010 { 2011 Tcl_SetResult(tclinfo.interp, _("cannot replace line"), TCL_STATIC); 2012 err = TCL_ERROR; 2013 break; 2014 } 2015 if (first_line == 0) 2016 first_line = rs; 2017 last_line = rs; 2018 } 2019 ++rs; 2020 ++lnum; 2021 Tcl_UpdateLinkedVar(tclinfo.interp, var_lnum); 2022 } 2023 if (first_line) 2024 changed_lines(first_line, 0, last_line + 1, (long)0); 2025 2026 Tcl_UnsetVar(tclinfo.interp, var_line, 0); 2027 Tcl_UnlinkVar(tclinfo.interp, var_lnum); 2028 if (err == TCL_OK) 2029 Tcl_ResetResult(tclinfo.interp); 2030 2031 (void)tclexit(err); 2032 } 2033 2034 static void 2035 tcldelallrefs(struct ref *ref) 2036 { 2037 struct ref *next; 2038 int err; 2039 char *result; 2040 2041 #ifdef DYNAMIC_TCL 2042 /* TODO: this code currently crashes Vim on exit */ 2043 if (exiting) 2044 return; 2045 #endif 2046 2047 while (ref != NULL) 2048 { 2049 next = ref->next; 2050 if (ref->interp) 2051 { 2052 if (ref->delcmd) 2053 { 2054 err = Tcl_GlobalEvalObj(ref->interp, ref->delcmd); 2055 if (err != TCL_OK) 2056 { 2057 result = (char *)Tcl_GetStringResult(ref->interp); 2058 if (result) 2059 tclerrmsg(result); 2060 } 2061 Tcl_DecrRefCount(ref->delcmd); 2062 ref->delcmd = NULL; 2063 } 2064 Tcl_DeleteCommandFromToken(ref->interp, ref->cmd); 2065 } 2066 Tcl_Free((char *)ref); 2067 ref = next; 2068 } 2069 } 2070 2071 void 2072 tcl_buffer_free(buf_T *buf) 2073 { 2074 struct ref *reflist; 2075 2076 #ifdef DYNAMIC_TCL 2077 if (!stubs_initialized) /* Not using Tcl, nothing to do. */ 2078 return; 2079 #endif 2080 2081 reflist = (struct ref *)(buf->b_tcl_ref); 2082 if (reflist != &refsdeleted) 2083 { 2084 buf->b_tcl_ref = (void *)&refsdeleted; 2085 tcldelallrefs(reflist); 2086 buf->b_tcl_ref = NULL; 2087 } 2088 } 2089 2090 void 2091 tcl_window_free(win_T *win) 2092 { 2093 struct ref *reflist; 2094 2095 #ifdef DYNAMIC_TCL 2096 if (!stubs_initialized) /* Not using Tcl, nothing to do. */ 2097 return; 2098 #endif 2099 2100 reflist = (struct ref*)(win->w_tcl_ref); 2101 if (reflist != &refsdeleted) 2102 { 2103 win->w_tcl_ref = (void *)&refsdeleted; 2104 tcldelallrefs(reflist); 2105 win->w_tcl_ref = NULL; 2106 } 2107 } 2108 2109 /* The End */ 2110