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