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