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