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