src/if_tcl.c

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