Merge branch 'feat/tagfunc'
[vim_extended.git] / src / if_tcl.c
blob6ec48cc05309be8685b2c801f417171060dee217
1 /* vi:set ts=8 sw=4:
3 * VIM - Vi IMproved by Bram Moolenaar
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 */
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.
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).
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.
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.
32 * set wl [::vim::window list] # Get list of Tcl commands of all windows.
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.
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
69 #include "vim.h"
70 #undef EXTERN /* tcl.h defines it too */
72 #ifdef DYNAMIC_TCL
73 # define USE_TCL_STUBS /* use tcl's stubs mechanism */
74 #endif
76 #include <tcl.h>
77 #include <errno.h>
78 #include <string.h>
80 typedef struct
82 Tcl_Interp *interp;
83 int range_start, range_end;
84 int lbase;
85 char *curbuf, *curwin;
86 } tcl_info;
88 static tcl_info tclinfo = { NULL, 0, 0, 0, NULL, NULL };
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
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))
106 #define VIMOUT ((ClientData)1)
107 #define VIMERR ((ClientData)2)
109 /* This appears to be new in Tcl 8.4. */
110 #ifndef CONST84
111 # define CONST84
112 #endif
115 * List of Tcl interpreters who reference a vim window or buffer.
116 * Each buffer and window has it's own list in the w_tcl_ref or b_tcl_ref
117 * struct member. We need this because Tcl can create sub-interpreters with
118 * the "interp" command, and each interpreter can reference all windows and
119 * buffers.
121 struct ref
123 struct ref *next;
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*) */
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));
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));
145 static struct ref refsdeleted; /* dummy object for deleted ref list */
147 /*****************************************************************************
148 * TCL interface manager
149 ****************************************************************************/
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
159 # ifndef DYNAMIC_TCL /* Just generating prototypes */
160 typedef int HANDLE;
161 # endif
164 * Declare HANDLE for tcl.dll and function pointers.
166 static HANDLE hTclLib = NULL;
167 Tcl_Interp* (*dll_Tcl_CreateInterp)();
170 * Table of name to function pointer of tcl.
172 #define TCL_PROC FARPROC
173 static struct {
174 char* name;
175 TCL_PROC* ptr;
176 } tcl_funcname_table[] = {
177 {"Tcl_CreateInterp", (TCL_PROC*)&dll_Tcl_CreateInterp},
178 {NULL, NULL},
182 * Make all runtime-links of tcl.
184 * 1. Get module handle using LoadLibraryEx.
185 * 2. Get pointer to tcl function by GetProcAddress.
186 * 3. Repeat 2, until get all functions will be used.
188 * Parameter 'libname' provides name of DLL.
189 * Return OK or FAIL.
191 static int
192 tcl_runtime_link_init(char *libname, int verbose)
194 int i;
196 if (hTclLib)
197 return OK;
198 if (!(hTclLib = LoadLibraryEx(libname, NULL, 0)))
200 if (verbose)
201 EMSG2(_(e_loadlib), libname);
202 return FAIL;
204 for (i = 0; tcl_funcname_table[i].ptr; ++i)
206 if (!(*tcl_funcname_table[i].ptr = GetProcAddress(hTclLib,
207 tcl_funcname_table[i].name)))
209 FreeLibrary(hTclLib);
210 hTclLib = NULL;
211 if (verbose)
212 EMSG2(_(e_loadfunc), tcl_funcname_table[i].name);
213 return FAIL;
216 return OK;
218 #endif /* defined(DYNAMIC_TCL) || defined(PROTO) */
220 #ifdef DYNAMIC_TCL
221 static char *find_executable_arg = NULL;
222 #endif
224 void
225 vim_tcl_init(arg)
226 char *arg;
228 #ifndef DYNAMIC_TCL
229 Tcl_FindExecutable(arg);
230 #else
231 find_executable_arg = arg;
232 #endif
235 #if defined(DYNAMIC_TCL) || defined(PROTO)
237 static int stubs_initialized = FALSE;
240 * Return TRUE if the TCL interface can be used.
243 tcl_enabled(verbose)
244 int verbose;
246 if (!stubs_initialized && find_executable_arg != NULL
247 && tcl_runtime_link_init(DYNAMIC_TCL_DLL, verbose) == OK)
249 Tcl_Interp *interp;
251 if (interp = dll_Tcl_CreateInterp())
253 if (Tcl_InitStubs(interp, DYNAMIC_TCL_VER, 0))
255 Tcl_FindExecutable(find_executable_arg);
256 Tcl_DeleteInterp(interp);
257 stubs_initialized = TRUE;
259 /* FIXME: When Tcl_InitStubs() was failed, how delete interp? */
262 return stubs_initialized;
264 #endif
266 void
267 tcl_end()
269 #ifdef DYNAMIC_TCL
270 if (hTclLib)
272 FreeLibrary(hTclLib);
273 hTclLib = NULL;
275 #endif
278 /****************************************************************************
279 Tcl commands
280 ****************************************************************************/
283 * Replace standard "exit" and "catch" commands.
285 * This is a design flaw in Tcl - the standard "exit" command just calls
286 * exit() and kills the application. It should return TCL_EXIT to the
287 * app, which then decides if it wants to terminate or not. In our case,
288 * we just delete the Tcl interpreter (and create a new one with the next
289 * :tcl command).
291 #define TCL_EXIT 5
293 static int
294 exitcmd(dummy, interp, objc, objv)
295 ClientData dummy UNUSED;
296 Tcl_Interp *interp;
297 int objc;
298 Tcl_Obj *CONST objv[];
300 int value = 0;
302 switch (objc)
304 case 2:
305 if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK)
306 break;
307 /* FALLTHROUGH */
308 case 1:
309 Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
310 return TCL_EXIT;
311 default:
312 Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
314 return TCL_ERROR;
317 static int
318 catchcmd(dummy, interp, objc, objv)
319 ClientData dummy UNUSED;
320 Tcl_Interp *interp;
321 int objc;
322 Tcl_Obj *CONST objv[];
324 char *varname = NULL;
325 int result;
327 switch (objc)
329 case 3:
330 varname = Tcl_GetStringFromObj(objv[2], NULL);
331 /* fallthrough */
332 case 2:
333 Tcl_ResetResult(interp);
334 Tcl_AllowExceptions(interp);
335 result = Tcl_EvalObj(interp, objv[1]);
336 if (result == TCL_EXIT)
337 return result;
338 if (varname)
340 if (Tcl_SetVar(interp, varname, Tcl_GetStringResult(interp), 0) == NULL)
342 Tcl_SetResult(interp, "couldn't save command result in variable", TCL_STATIC);
343 return TCL_ERROR;
346 Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
347 return TCL_OK;
348 default:
349 Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
351 return TCL_ERROR;
355 * "::vim::beep" - what Vi[m] does best :-)
357 static int
358 beepcmd(dummy, interp, objc, objv)
359 ClientData dummy UNUSED;
360 Tcl_Interp *interp;
361 int objc;
362 Tcl_Obj *CONST objv[];
364 if (objc != 1)
366 Tcl_WrongNumArgs(interp, 1, objv, NULL);
367 return TCL_ERROR;
369 vim_beep();
370 return TCL_OK;
374 * "::vim::buffer list" - create a list of buffer commands.
375 * "::vim::buffer {N}" - create buffer command for buffer N.
376 * "::vim::buffer new" - create a new buffer (not implemented)
378 static int
379 buffercmd(dummy, interp, objc, objv)
380 ClientData dummy UNUSED;
381 Tcl_Interp *interp;
382 int objc;
383 Tcl_Obj *CONST objv[];
385 char *name;
386 buf_T *buf;
387 Tcl_Obj *resobj;
388 int err, n, idx;
389 enum {BCMD_EXISTS, BCMD_LIST};
390 static CONST84 char *bcmdoptions[] =
392 "exists", "list", (char *)0
395 if (objc < 2)
397 Tcl_WrongNumArgs(interp, 1, objv, "option");
398 return TCL_ERROR;
400 err = Tcl_GetIntFromObj(interp, objv[1], &n);
401 if (err == TCL_OK)
403 if (objc != 2)
405 Tcl_WrongNumArgs(interp, 1, objv, "bufNumber");
406 return TCL_ERROR;
408 for (buf = firstbuf; buf != NULL; buf = buf->b_next)
410 if (buf->b_fnum == n)
412 name = tclgetbuffer(interp, buf);
413 if (name == NULL)
414 return TCL_ERROR;
415 Tcl_SetResult(interp, name, TCL_VOLATILE);
416 return TCL_OK;
419 Tcl_SetResult(interp, _("invalid buffer number"), TCL_STATIC);
420 return TCL_ERROR;
422 Tcl_ResetResult(interp); /* clear error from Tcl_GetIntFromObj */
424 err = Tcl_GetIndexFromObj(interp, objv[1], bcmdoptions, "option", 0, &idx);
425 if (err != TCL_OK)
426 return err;
427 switch (idx)
429 case BCMD_LIST:
430 if (objc != 2)
432 Tcl_WrongNumArgs(interp, 2, objv, "");
433 err = TCL_ERROR;
434 break;
436 for (buf = firstbuf; buf != NULL; buf = buf->b_next)
438 name = tclgetbuffer(interp, buf);
439 if (name == NULL)
441 err = TCL_ERROR;
442 break;
444 Tcl_AppendElement(interp, name);
446 break;
448 case BCMD_EXISTS:
449 if (objc != 3)
451 Tcl_WrongNumArgs(interp, 2, objv, "bufNumber");
452 err = TCL_ERROR;
453 break;
455 err = Tcl_GetIntFromObj(interp, objv[2], &n);
456 if (err == TCL_OK)
458 buf = buflist_findnr(n);
459 resobj = Tcl_NewIntObj(buf != NULL);
460 Tcl_SetObjResult(interp, resobj);
462 break;
464 default:
465 Tcl_SetResult(interp, _("not implemented yet"), TCL_STATIC);
466 err = TCL_ERROR;
468 return err;
472 * "::vim::window list" - create list of window commands.
474 static int
475 windowcmd(dummy, interp, objc, objv)
476 ClientData dummy UNUSED;
477 Tcl_Interp *interp;
478 int objc;
479 Tcl_Obj *CONST objv[];
481 char *what, *string;
482 win_T *win;
484 if (objc != 2)
486 Tcl_WrongNumArgs(interp, 1, objv, "option");
487 return TCL_ERROR;
489 what = Tcl_GetStringFromObj(objv[1], NULL);
490 if (strcmp(what, "list") == 0)
492 FOR_ALL_WINDOWS(win)
494 string = tclgetwindow(interp, win);
495 if (string == NULL)
496 return TCL_ERROR;
497 Tcl_AppendElement(interp, string);
499 return TCL_OK;
501 Tcl_SetResult(interp, _("unknown option"), TCL_STATIC);
502 return TCL_ERROR;
506 * flags for bufselfcmd and winselfcmd to indicate outstanding actions.
508 #define FL_UPDATE_SCREEN (1<<0)
509 #define FL_UPDATE_CURBUF (1<<1)
510 #define FL_ADJUST_CURSOR (1<<2)
513 * This function implements the buffer commands.
515 static int
516 bufselfcmd(ref, interp, objc, objv)
517 ClientData ref;
518 Tcl_Interp *interp;
519 int objc;
520 Tcl_Obj *CONST objv[];
522 int opt, err, idx, flags;
523 int val1, val2, n, i;
524 buf_T *buf, *savebuf;
525 win_T *win, *savewin;
526 Tcl_Obj *resobj;
527 pos_T *pos;
528 char *line;
530 enum
532 BUF_APPEND, BUF_COMMAND, BUF_COUNT, BUF_DELCMD, BUF_DELETE, BUF_EXPR,
533 BUF_GET, BUF_INSERT, BUF_LAST, BUF_MARK, BUF_NAME, BUF_NUMBER,
534 BUF_OPTION, BUF_SET, BUF_WINDOWS
536 static CONST84 char *bufoptions[] =
538 "append", "command", "count", "delcmd", "delete", "expr",
539 "get", "insert", "last", "mark", "name", "number",
540 "option", "set", "windows", (char *)0
543 if (objc < 2)
545 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
546 return TCL_ERROR;
549 err = Tcl_GetIndexFromObj(interp, objv[1], bufoptions, "option", 0, &idx);
550 if (err != TCL_OK)
551 return err;
553 buf = (buf_T *)((struct ref *)ref)->vimobj;
554 savebuf = curbuf; curbuf = buf;
555 savewin = curwin; curwin = tclfindwin(buf);
556 flags = 0;
557 opt = 0;
559 switch (idx)
561 case BUF_COMMAND:
562 err = tcldoexcommand(interp, objc, objv, 2);
563 flags |= FL_UPDATE_SCREEN;
564 break;
566 case BUF_OPTION:
567 err = tclsetoption(interp, objc, objv, 2);
568 flags |= FL_UPDATE_SCREEN;
569 break;
571 case BUF_EXPR:
572 err = tclvimexpr(interp, objc, objv, 2);
573 break;
575 case BUF_NAME:
577 * Get filename of buffer.
579 if (objc != 2)
581 Tcl_WrongNumArgs(interp, 2, objv, NULL);
582 err = TCL_ERROR;
583 break;
585 if (buf->b_ffname)
586 Tcl_SetResult(interp, (char *)buf->b_ffname, TCL_VOLATILE);
587 else
588 Tcl_SetResult(interp, "", TCL_STATIC);
589 break;
591 case BUF_LAST:
593 * Get line number of last line.
595 opt = 1;
596 /* fallthrough */
597 case BUF_COUNT:
599 * Get number of lines in buffer.
601 if (objc != 2)
603 Tcl_WrongNumArgs(interp, 2, objv, NULL);
604 err = TCL_ERROR;
605 break;
607 val1 = (int)buf->b_ml.ml_line_count;
608 if (opt)
609 val1 = row2tcl(val1);
611 resobj = Tcl_NewIntObj(val1);
612 Tcl_SetObjResult(interp, resobj);
613 break;
615 case BUF_NUMBER:
617 * Get buffer's number.
619 if (objc != 2)
621 Tcl_WrongNumArgs(interp, 2, objv, NULL);
622 err = TCL_ERROR;
623 break;
625 resobj = Tcl_NewIntObj((int)buf->b_fnum);
626 Tcl_SetObjResult(interp, resobj);
627 break;
629 case BUF_GET:
630 if (objc != 3 && objc != 4)
632 Tcl_WrongNumArgs(interp, 2, objv, "lineNumber ?lineNumber?");
633 err = TCL_ERROR;
634 break;
636 err = tclgetlinenum(interp, objv[2], &val1, buf);
637 if (err != TCL_OK)
638 break;
639 if (objc == 4)
641 err = tclgetlinenum(interp, objv[3], &val2, buf);
642 if (err != TCL_OK)
643 break;
644 if (val1 > val2)
646 n = val1; val1 = val2; val2 = n;
648 Tcl_ResetResult(interp);
650 for (n = val1; n <= val2 && err == TCL_OK; n++)
652 line = (char *)ml_get_buf(buf, (linenr_T)n, FALSE);
653 if (line)
654 Tcl_AppendElement(interp, line);
655 else
656 err = TCL_ERROR;
659 else { /* objc == 3 */
660 line = (char *)ml_get_buf(buf, (linenr_T)val1, FALSE);
661 Tcl_SetResult(interp, line, TCL_VOLATILE);
663 break;
665 case BUF_SET:
666 if (objc != 4 && objc != 5)
668 Tcl_WrongNumArgs(interp, 3, objv, "lineNumber ?lineNumber? stringOrList");
669 err = TCL_ERROR;
670 break;
672 err = tclgetlinenum(interp, objv[2], &val1, buf);
673 if (err != TCL_OK)
674 return TCL_ERROR;
675 if (objc == 4)
678 * Replace one line with a string.
679 * $buf set {n} {string}
681 line = Tcl_GetStringFromObj(objv[3], NULL);
682 if (u_savesub((linenr_T)val1) != OK)
684 Tcl_SetResult(interp, _("cannot save undo information"), TCL_STATIC);
685 err = TCL_ERROR;
687 else
688 if (ml_replace((linenr_T)val1, (char_u *)line, TRUE) != OK)
690 Tcl_SetResult(interp, _("cannot replace line"), TCL_STATIC);
691 err = TCL_ERROR;
693 else
695 changed_bytes((linenr_T)val1, 0);
696 flags |= FL_UPDATE_CURBUF;
698 break;
700 else
703 * Replace several lines with the elements of a Tcl list.
704 * $buf set {n} {m} {list}
705 * If the list contains more than {m}-{n}+1 elements, they
706 * are * inserted after line {m}. If the list contains fewer
707 * elements, * the lines from {n}+length({list}) through {m}
708 * are deleted.
710 int lc;
711 Tcl_Obj **lv;
713 err = tclgetlinenum(interp, objv[3], &val2, buf);
714 if (err != TCL_OK)
715 break;
716 err = Tcl_ListObjGetElements(interp, objv[4], &lc, &lv);
717 if (err != TCL_OK)
718 break;
719 if (val1 > val2)
721 n = val1;
722 val1 = val2;
723 val2 = n;
726 n = val1;
727 if (u_save((linenr_T)(val1 - 1), (linenr_T)(val2 + 1)) != OK)
729 Tcl_SetResult(interp, _("cannot save undo information"),
730 TCL_STATIC);
731 err = TCL_ERROR;
732 break;
734 flags |= FL_UPDATE_CURBUF;
736 for (i = 0; i < lc && n <= val2; i++)
738 line = Tcl_GetStringFromObj(lv[i], NULL);
739 if (ml_replace((linenr_T)n, (char_u *)line, TRUE) != OK)
740 goto setListError;
741 ++n;
743 if (i < lc)
745 /* append lines */
748 line = Tcl_GetStringFromObj(lv[i], NULL);
749 if (ml_append((linenr_T)(n - 1),
750 (char_u *)line, 0, FALSE) != OK)
751 goto setListError;
752 ++n;
753 ++i;
754 } while (i < lc);
756 else if (n <= val2)
758 /* did not replace all lines, delete */
759 i = n;
762 if (ml_delete((linenr_T)i, FALSE) != OK)
763 goto setListError;
764 ++n;
765 } while (n <= val2);
767 lc -= val2 - val1 + 1; /* number of lines to be replaced */
768 mark_adjust((linenr_T)val1, (linenr_T)val2, (long)MAXLNUM,
769 (long)lc);
770 changed_lines((linenr_T)val1, 0, (linenr_T)val2 + 1, (long)lc);
771 break;
772 setListError:
773 u_undo(1); /* ??? */
774 Tcl_SetResult(interp, _("cannot set line(s)"), TCL_STATIC);
775 err = TCL_ERROR;
777 break;
779 case BUF_DELETE:
780 if (objc != 3 && objc != 4)
782 Tcl_WrongNumArgs(interp, 3, objv, "lineNumber ?lineNumber?");
783 err = TCL_ERROR;
784 break;
786 err = tclgetlinenum(interp, objv[2], &val1, buf);
787 if (err != TCL_OK)
788 break;
789 val2 = val1;
790 if (objc == 4)
792 err = tclgetlinenum(interp, objv[3], &val2, buf);
793 if (err != TCL_OK)
794 return err;
795 if (val1 > val2)
797 i = val1; val1 = val2; val2 = i;
800 n = val2 - val1 + 1;
801 if (u_savedel((linenr_T)val1, (long)n) != OK)
803 Tcl_SetResult(interp, _("cannot save undo information"),
804 TCL_STATIC);
805 err = TCL_ERROR;
806 break;
808 for (i = 0; i < n; i++)
810 ml_delete((linenr_T)val1, FALSE);
811 err = vimerror(interp);
812 if (err != TCL_OK)
813 break;
815 if (i > 0)
816 deleted_lines_mark((linenr_T)val1, (long)i);
817 flags |= FL_ADJUST_CURSOR|FL_UPDATE_SCREEN;
818 break;
820 case BUF_MARK:
821 if (objc != 3)
823 Tcl_WrongNumArgs(interp, 2, objv, "markName");
824 err = TCL_ERROR;
825 break;
827 line = Tcl_GetStringFromObj(objv[2], NULL);
829 pos = NULL;
830 if (line[0] != '\0' && line[1] == '\0')
832 pos = getmark(line[0], FALSE);
834 if (pos == NULL)
836 Tcl_SetResult(interp, _("invalid mark name"), TCL_STATIC);
837 err = TCL_ERROR;
838 break;
840 err = vimerror(interp);
841 if (err != TCL_OK)
842 break;
843 if (pos->lnum <= 0)
845 Tcl_SetResult(interp, _("mark not set"), TCL_STATIC);
846 err = TCL_ERROR;
848 else
850 char rbuf[64];
852 sprintf(rbuf, _("row %d column %d"),
853 (int)row2tcl(pos->lnum), (int)col2tcl(pos->col));
854 Tcl_SetResult(interp, rbuf, TCL_VOLATILE);
856 break;
858 case BUF_INSERT:
859 opt = 1;
860 /* fallthrough */
861 case BUF_APPEND:
862 if (objc != 4)
864 Tcl_WrongNumArgs(interp, 2, objv, "lineNum text");
865 err = TCL_ERROR;
866 break;
868 err = tclgetlinenum(interp, objv[2], &val1, buf);
869 if (err != TCL_OK)
870 break;
871 if (opt)
872 --val1;
873 if (u_save((linenr_T)val1, (linenr_T)(val1+1)) != OK)
875 Tcl_SetResult(interp, _("cannot save undo information"),
876 TCL_STATIC);
877 err = TCL_ERROR;
878 break;
881 line = Tcl_GetStringFromObj(objv[3], NULL);
882 if (ml_append((linenr_T)val1, (char_u *)line, 0, FALSE) != OK)
884 Tcl_SetResult(interp, _("cannot insert/append line"),
885 TCL_STATIC);
886 err = TCL_ERROR;
887 break;
889 appended_lines_mark((linenr_T)val1, 1L);
890 flags |= FL_UPDATE_SCREEN;
891 break;
893 case BUF_WINDOWS:
895 * Return list of window commands.
897 if (objc != 2)
899 Tcl_WrongNumArgs(interp, 2, objv, NULL);
900 err = TCL_ERROR;
901 break;
903 Tcl_ResetResult(interp);
904 FOR_ALL_WINDOWS(win)
906 if (win->w_buffer == buf)
908 line = tclgetwindow(interp, win);
909 if (line != NULL)
910 Tcl_AppendElement(interp, line);
911 else
913 err = TCL_ERROR;
914 break;
918 break;
920 case BUF_DELCMD:
922 * Register deletion callback.
923 * TODO: Should be able to register multiple callbacks
925 if (objc != 3)
927 Tcl_WrongNumArgs(interp, 2, objv, "command");
928 err = TCL_ERROR;
929 break;
931 err = tclsetdelcmd(interp, buf->b_tcl_ref, (void *)buf, objv[2]);
932 break;
934 default:
935 Tcl_SetResult(interp, _("not implemented yet"), TCL_STATIC);
936 err = TCL_ERROR;
939 if (flags & FL_UPDATE_CURBUF)
940 redraw_curbuf_later(NOT_VALID);
941 curbuf = savebuf;
942 curwin = savewin;
943 if (flags & FL_ADJUST_CURSOR)
944 check_cursor();
945 if (flags & (FL_UPDATE_SCREEN | FL_UPDATE_CURBUF))
946 update_screen(NOT_VALID);
948 return err;
952 * This function implements the window commands.
954 static int
955 winselfcmd(ref, interp, objc, objv)
956 ClientData ref;
957 Tcl_Interp *interp;
958 int objc;
959 Tcl_Obj *CONST objv[];
961 int err, idx, flags;
962 int val1, val2;
963 Tcl_Obj *resobj;
964 win_T *savewin, *win;
965 buf_T *savebuf;
966 char *str;
968 enum
970 WIN_BUFFER, WIN_COMMAND, WIN_CURSOR, WIN_DELCMD, WIN_EXPR,
971 WIN_HEIGHT, WIN_OPTION
973 static CONST84 char *winoptions[] =
975 "buffer", "command", "cursor", "delcmd", "expr",
976 "height", "option", (char *)0
979 if (objc < 2)
981 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
982 return TCL_ERROR;
985 err = Tcl_GetIndexFromObj(interp, objv[1], winoptions, "option", 0, &idx);
986 if (err != TCL_OK)
987 return TCL_ERROR;
989 win = (win_T *)((struct ref *)ref)->vimobj;
990 savewin = curwin; curwin = win;
991 savebuf = curbuf; curbuf = win->w_buffer;
992 flags = 0;
994 switch (idx)
996 case WIN_OPTION:
997 err = tclsetoption(interp, objc, objv, 2);
998 flags |= FL_UPDATE_SCREEN;
999 break;
1001 case WIN_COMMAND:
1002 err = tcldoexcommand(interp, objc, objv, 2);
1003 flags |= FL_UPDATE_SCREEN;
1004 break;
1006 case WIN_EXPR:
1007 err = tclvimexpr(interp, objc, objv, 2);
1008 break;
1010 case WIN_HEIGHT:
1011 if (objc == 3)
1013 err = Tcl_GetIntFromObj(interp, objv[2], &val1);
1014 if (err != TCL_OK)
1015 break;
1016 #ifdef FEAT_GUI
1017 need_mouse_correct = TRUE;
1018 #endif
1019 win_setheight(val1);
1020 err = vimerror(interp);
1021 if (err != TCL_OK)
1022 break;
1024 else
1025 if (objc != 2)
1027 Tcl_WrongNumArgs(interp, 2, objv, "?value?");
1028 err = TCL_ERROR;
1029 break;
1032 resobj = Tcl_NewIntObj((int)(win->w_height));
1033 Tcl_SetObjResult(interp, resobj);
1034 break;
1036 case WIN_BUFFER:
1037 if (objc != 2)
1039 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1040 err = TCL_ERROR;
1041 break;
1043 str = tclgetbuffer(interp, win->w_buffer);
1044 if (str)
1045 Tcl_SetResult(interp, str, TCL_VOLATILE);
1046 else
1047 err = TCL_ERROR;
1048 break;
1050 case WIN_DELCMD:
1051 if (objc != 3)
1053 Tcl_WrongNumArgs(interp, 2, objv, "command");
1054 err = TCL_ERROR;
1055 break;
1057 err = tclsetdelcmd(interp, win->w_tcl_ref, (void *)win, objv[2]);
1058 break;
1060 case WIN_CURSOR:
1061 if (objc > 4)
1063 Tcl_WrongNumArgs(interp, 2, objv, "?arg1 ?arg2??");
1064 err = TCL_ERROR;
1065 break;
1067 if (objc == 2)
1069 char buf[64];
1071 sprintf(buf, _("row %d column %d"), (int)row2tcl(win->w_cursor.lnum), (int)col2tcl(win->w_cursor.col));
1072 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1073 break;
1075 else if (objc == 3)
1077 Tcl_Obj *part, *var;
1079 part = Tcl_NewStringObj("row", -1);
1080 var = Tcl_ObjGetVar2(interp, objv[2], part, TCL_LEAVE_ERR_MSG);
1081 if (var == NULL)
1083 err = TCL_ERROR;
1084 break;
1086 err = tclgetlinenum(interp, var, &val1, win->w_buffer);
1087 if (err != TCL_OK)
1088 break;
1089 part = Tcl_NewStringObj("column", -1);
1090 var = Tcl_ObjGetVar2(interp, objv[2], part, TCL_LEAVE_ERR_MSG);
1091 if (var == NULL)
1093 err = TCL_ERROR;
1094 break;
1096 err = Tcl_GetIntFromObj(interp, var, &val2);
1097 if (err != TCL_OK)
1098 break;
1100 else { /* objc == 4 */
1101 err = tclgetlinenum(interp, objv[2], &val1, win->w_buffer);
1102 if (err != TCL_OK)
1103 break;
1104 err = Tcl_GetIntFromObj(interp, objv[3], &val2);
1105 if (err != TCL_OK)
1106 break;
1108 /* TODO: should check column */
1109 win->w_cursor.lnum = val1;
1110 win->w_cursor.col = col2vim(val2);
1111 flags |= FL_UPDATE_SCREEN;
1112 break;
1114 default:
1115 Tcl_SetResult(interp, _("not implemented yet"), TCL_STATIC);
1116 break;
1119 curwin = savewin;
1120 curbuf = savebuf;
1121 if (flags & FL_UPDATE_SCREEN)
1122 update_screen(NOT_VALID);
1124 return err;
1128 static int
1129 commandcmd(dummy, interp, objc, objv)
1130 ClientData dummy UNUSED;
1131 Tcl_Interp *interp;
1132 int objc;
1133 Tcl_Obj *CONST objv[];
1135 int err;
1137 err = tcldoexcommand(interp, objc, objv, 1);
1138 update_screen(VALID);
1139 return err;
1142 static int
1143 optioncmd(dummy, interp, objc, objv)
1144 ClientData dummy UNUSED;
1145 Tcl_Interp *interp;
1146 int objc;
1147 Tcl_Obj *CONST objv[];
1149 int err;
1151 err = tclsetoption(interp, objc, objv, 1);
1152 update_screen(VALID);
1153 return err;
1156 static int
1157 exprcmd(dummy, interp, objc, objv)
1158 ClientData dummy UNUSED;
1159 Tcl_Interp *interp;
1160 int objc;
1161 Tcl_Obj *CONST objv[];
1163 return tclvimexpr(interp, objc, objv, 1);
1166 /****************************************************************************
1167 Support functions for Tcl commands
1168 ****************************************************************************/
1171 * Get a line number from 'obj' and convert it to vim's range.
1173 static int
1174 tclgetlinenum(interp, obj, valueP, buf)
1175 Tcl_Interp *interp;
1176 Tcl_Obj *obj;
1177 int *valueP;
1178 buf_T *buf;
1180 int err, i;
1182 enum { LN_BEGIN, LN_BOTTOM, LN_END, LN_FIRST, LN_LAST, LN_START, LN_TOP };
1184 static CONST84 char *keyw[] =
1186 "begin", "bottom", "end", "first", "last", "start", "top", (char *)0
1189 err = Tcl_GetIndexFromObj(interp, obj, keyw, "", 0, &i);
1190 if (err == TCL_OK)
1192 switch (i)
1194 case LN_BEGIN:
1195 case LN_FIRST:
1196 case LN_START:
1197 case LN_TOP:
1198 *valueP = 1;
1199 break;
1200 case LN_BOTTOM:
1201 case LN_END:
1202 case LN_LAST:
1203 *valueP = buf->b_ml.ml_line_count;
1204 break;
1206 return TCL_OK;
1208 Tcl_ResetResult(interp);
1210 err = Tcl_GetIntFromObj(interp, obj, &i);
1211 if (err != TCL_OK)
1212 return err;
1213 i = row2vim(i);
1214 if (i < 1 || i > buf->b_ml.ml_line_count)
1216 Tcl_SetResult(interp, _("line number out of range"), TCL_STATIC);
1217 return TCL_ERROR;
1219 *valueP = i;
1220 return TCL_OK;
1224 * Find the first window in the window list that displays the buffer.
1226 static win_T *
1227 tclfindwin(buf)
1228 buf_T *buf;
1230 win_T *win;
1232 FOR_ALL_WINDOWS(win)
1234 if (win->w_buffer == buf)
1235 return win;
1237 return curwin; /* keep current window context */
1241 * Do-it-all function for "::vim::command", "$buf command" and "$win command".
1243 static int
1244 tcldoexcommand(interp, objc, objv, objn)
1245 Tcl_Interp *interp;
1246 int objc;
1247 Tcl_Obj *CONST objv[];
1248 int objn;
1250 tcl_info saveinfo;
1251 int err, flag, nobjs;
1252 char *arg;
1254 nobjs = objc - objn;
1255 if (nobjs < 1 || nobjs > 2)
1257 Tcl_WrongNumArgs(interp, objn, objv, "?-quiet? exCommand");
1258 return TCL_ERROR;
1261 flag = 0;
1262 if (nobjs == 2)
1264 arg = Tcl_GetStringFromObj(objv[objn], NULL);
1265 if (strcmp(arg, "-quiet") == 0)
1266 flag = 1;
1267 else
1269 Tcl_ResetResult(interp);
1270 Tcl_AppendResult(interp, _("unknown flag: "), arg, (char *)0);
1271 return TCL_ERROR;
1273 ++objn;
1276 memcpy(&saveinfo, &tclinfo, sizeof(tcl_info));
1277 tclinfo.interp = NULL;
1278 tclinfo.curwin = NULL;
1279 tclinfo.curbuf = NULL;
1281 arg = Tcl_GetStringFromObj(objv[objn], NULL);
1282 if (flag)
1283 ++emsg_off;
1284 do_cmdline_cmd((char_u *)arg);
1285 if (flag)
1286 --emsg_off;
1287 err = vimerror(interp);
1289 /* If the ex command created a new Tcl interpreter, remove it */
1290 if (tclinfo.interp)
1291 tcldelthisinterp();
1292 memcpy(&tclinfo, &saveinfo, sizeof(tcl_info));
1293 tclupdatevars();
1295 return err;
1299 * Do-it-all function for "::vim::option", "$buf option" and "$win option".
1301 static int
1302 tclsetoption(interp, objc, objv, objn)
1303 Tcl_Interp *interp;
1304 int objc;
1305 Tcl_Obj *CONST objv[];
1306 int objn;
1308 int err, nobjs, idx;
1309 char_u *option;
1310 int isnum;
1311 long lval;
1312 char_u *sval;
1313 Tcl_Obj *resobj;
1315 enum { OPT_OFF, OPT_ON, OPT_TOGGLE };
1316 static CONST84 char *optkw[] = { "off", "on", "toggle", (char *)0 };
1318 nobjs = objc - objn;
1319 if (nobjs != 1 && nobjs != 2)
1321 Tcl_WrongNumArgs(interp, objn, objv, "vimOption ?value?");
1322 return TCL_ERROR;
1325 option = (char_u *)Tcl_GetStringFromObj(objv[objn], NULL);
1326 ++objn;
1327 isnum = get_option_value(option, &lval, &sval, 0);
1328 err = TCL_OK;
1329 switch (isnum)
1331 case 0:
1332 Tcl_SetResult(interp, (char *)sval, TCL_VOLATILE);
1333 vim_free(sval);
1334 break;
1335 case 1:
1336 resobj = Tcl_NewLongObj(lval);
1337 Tcl_SetObjResult(interp, resobj);
1338 break;
1339 default:
1340 Tcl_SetResult(interp, _("unknown vimOption"), TCL_STATIC);
1341 return TCL_ERROR;
1343 if (nobjs == 2)
1345 if (isnum)
1347 sval = NULL; /* avoid compiler warning */
1348 err = Tcl_GetIndexFromObj(interp, objv[objn], optkw, "", 0, &idx);
1349 if (err != TCL_OK)
1351 Tcl_ResetResult(interp);
1352 err = Tcl_GetLongFromObj(interp, objv[objn], &lval);
1354 else
1355 switch (idx)
1357 case OPT_ON:
1358 lval = 1;
1359 break;
1360 case OPT_OFF:
1361 lval = 0;
1362 break;
1363 case OPT_TOGGLE:
1364 lval = !lval;
1365 break;
1368 else
1369 sval = (char_u *)Tcl_GetStringFromObj(objv[objn], NULL);
1370 if (err == TCL_OK)
1372 set_option_value(option, lval, sval, OPT_LOCAL);
1373 err = vimerror(interp);
1376 return err;
1380 * Do-it-all function for "::vim::expr", "$buf expr" and "$win expr".
1382 static int
1383 tclvimexpr(interp, objc, objv, objn)
1384 Tcl_Interp *interp;
1385 int objc;
1386 Tcl_Obj *CONST objv[];
1387 int objn;
1389 #ifdef FEAT_EVAL
1390 char *expr, *str;
1391 #endif
1392 int err;
1394 if (objc - objn != 1)
1396 Tcl_WrongNumArgs(interp, objn, objv, "vimExpr");
1397 return TCL_ERROR;
1400 #ifdef FEAT_EVAL
1401 expr = Tcl_GetStringFromObj(objv[objn], NULL);
1402 str = (char *)eval_to_string((char_u *)expr, NULL, TRUE);
1403 if (str == NULL)
1404 Tcl_SetResult(interp, _("invalid expression"), TCL_STATIC);
1405 else
1406 Tcl_SetResult(interp, str, TCL_VOLATILE);
1407 err = vimerror(interp);
1408 #else
1409 Tcl_SetResult(interp, _("expressions disabled at compile time"), TCL_STATIC);
1410 err = TCL_ERROR;
1411 #endif
1413 return err;
1417 * Check for internal vim errors.
1419 static int
1420 vimerror(interp)
1421 Tcl_Interp *interp;
1423 if (got_int)
1425 Tcl_SetResult(interp, _("keyboard interrupt"), TCL_STATIC);
1426 return TCL_ERROR;
1428 else if (did_emsg)
1430 Tcl_SetResult(interp, _("vim error"), TCL_STATIC);
1431 return TCL_ERROR;
1433 return TCL_OK;
1437 * Functions that handle the reference lists:
1438 * delref() - callback for Tcl's DeleteCommand
1439 * tclgetref() - find/create Tcl command for a win_T* or buf_T* object
1440 * tclgetwindow() - window frontend for tclgetref()
1441 * tclgetbuffer() - buffer frontend for tclgetref()
1442 * tclsetdelcmd() - add Tcl callback command to a vim object
1444 static void
1445 delref(cref)
1446 ClientData cref;
1448 struct ref *ref = (struct ref *)cref;
1450 if (ref->delcmd)
1452 Tcl_DecrRefCount(ref->delcmd);
1453 ref->delcmd = NULL;
1455 ref->interp = NULL;
1458 static char *
1459 tclgetref(interp, refstartP, prefix, vimobj, proc)
1460 Tcl_Interp *interp;
1461 void **refstartP; /* ptr to w_tcl_ref/b_tcl-ref member of
1462 win_T/buf_T struct */
1463 char *prefix; /* "win" or "buf" */
1464 void *vimobj; /* win_T* or buf_T* */
1465 Tcl_ObjCmdProc *proc; /* winselfcmd or bufselfcmd */
1467 struct ref *ref, *unused = NULL;
1468 static char name[VARNAME_SIZE];
1469 Tcl_Command cmd;
1471 ref = (struct ref *)(*refstartP);
1472 if (ref == &refsdeleted)
1474 Tcl_SetResult(interp, _("cannot create buffer/window command: object is being deleted"), TCL_STATIC);
1475 return NULL;
1478 while (ref != NULL)
1480 if (ref->interp == interp)
1481 break;
1482 if (ref->interp == NULL)
1483 unused = ref;
1484 ref = ref->next;
1487 if (ref)
1488 vim_snprintf(name, sizeof(name), "::vim::%s",
1489 Tcl_GetCommandName(interp, ref->cmd));
1490 else
1492 if (unused)
1493 ref = unused;
1494 else
1496 ref = (struct ref *)Tcl_Alloc(sizeof(struct ref));
1497 #if 0 /* Tcl_Alloc either succeeds or does not return */
1498 if (!ref)
1500 Tcl_SetResult(interp, "out of memory", TCL_STATIC);
1501 return NULL;
1503 #endif
1504 ref->interp = NULL;
1505 ref->next = (struct ref *)(*refstartP);
1506 (*refstartP) = (void *)ref;
1509 /* This might break on some exotic systems... */
1510 vim_snprintf(name, sizeof(name), "::vim::%s_%lx",
1511 prefix, (unsigned long)vimobj);
1512 cmd = Tcl_CreateObjCommand(interp, name, proc,
1513 (ClientData)ref, (Tcl_CmdDeleteProc *)delref);
1514 if (!cmd)
1515 return NULL;
1517 ref->interp = interp;
1518 ref->cmd = cmd;
1519 ref->delcmd = NULL;
1520 ref->vimobj = vimobj;
1522 return name;
1525 static char *
1526 tclgetwindow(interp, win)
1527 Tcl_Interp *interp;
1528 win_T *win;
1530 return tclgetref(interp, &(win->w_tcl_ref), "win", (void *)win, winselfcmd);
1533 static char *
1534 tclgetbuffer(interp, buf)
1535 Tcl_Interp *interp;
1536 buf_T *buf;
1538 return tclgetref(interp, &(buf->b_tcl_ref), "buf", (void *)buf, bufselfcmd);
1541 static int
1542 tclsetdelcmd(interp, reflist, vimobj, delcmd)
1543 Tcl_Interp *interp;
1544 struct ref *reflist;
1545 void *vimobj;
1546 Tcl_Obj *delcmd;
1548 if (reflist == &refsdeleted)
1550 Tcl_SetResult(interp, _("cannot register callback command: buffer/window is already being deleted"), TCL_STATIC);
1551 return TCL_ERROR;
1554 while (reflist != NULL)
1556 if (reflist->interp == interp && reflist->vimobj == vimobj)
1558 if (reflist->delcmd)
1560 Tcl_DecrRefCount(reflist->delcmd);
1562 Tcl_IncrRefCount(delcmd);
1563 reflist->delcmd = delcmd;
1564 return TCL_OK;
1566 reflist = reflist->next;
1568 /* This should never happen. Famous last word? */
1569 EMSG(_("E280: TCL FATAL ERROR: reflist corrupt!? Please report this to vim-dev@vim.org"));
1570 Tcl_SetResult(interp, _("cannot register callback command: buffer/window reference not found"), TCL_STATIC);
1571 return TCL_ERROR;
1575 /*******************************************
1576 I/O Channel
1577 ********************************************/
1579 static int
1580 channel_close(instance, interp)
1581 ClientData instance;
1582 Tcl_Interp *interp UNUSED;
1584 int err = 0;
1586 /* currently does nothing */
1588 if (instance != VIMOUT && instance != VIMERR)
1590 Tcl_SetErrno(EBADF);
1591 err = EBADF;
1593 return err;
1596 static int
1597 channel_input(instance, buf, bufsiz, errptr)
1598 ClientData instance UNUSED;
1599 char *buf UNUSED;
1600 int bufsiz UNUSED;
1601 int *errptr;
1604 /* input is currently not supported */
1606 Tcl_SetErrno(EINVAL);
1607 if (errptr)
1608 *errptr = EINVAL;
1609 return -1;
1612 static int
1613 channel_output(instance, buf, bufsiz, errptr)
1614 ClientData instance;
1615 char *buf;
1616 int bufsiz;
1617 int *errptr;
1619 char_u *str;
1620 int result;
1622 /* The buffer is not guaranteed to be 0-terminated, and we don't if
1623 * there is enough room to add a '\0'. So we have to create a copy
1624 * of the buffer...
1626 str = vim_strnsave((char_u *)buf, bufsiz);
1627 if (!str)
1629 Tcl_SetErrno(ENOMEM);
1630 if (errptr)
1631 *errptr = ENOMEM;
1632 return -1;
1635 result = bufsiz;
1636 if (instance == VIMOUT)
1637 tclmsg((char *)str);
1638 else
1639 if (instance == VIMERR)
1640 tclerrmsg((char *)str);
1641 else
1643 Tcl_SetErrno(EBADF);
1644 if (errptr)
1645 *errptr = EBADF;
1646 result = -1;
1648 vim_free(str);
1649 return result;
1652 static void
1653 channel_watch(instance, mask)
1654 ClientData instance UNUSED;
1655 int mask UNUSED;
1657 Tcl_SetErrno(EINVAL);
1660 static int
1661 channel_gethandle(instance, direction, handleptr)
1662 ClientData instance UNUSED;
1663 int direction UNUSED;
1664 ClientData *handleptr UNUSED;
1666 Tcl_SetErrno(EINVAL);
1667 return EINVAL;
1671 static Tcl_ChannelType channel_type =
1673 "vimmessage", /* typeName */
1674 NULL, /* version */
1675 channel_close, /* closeProc */
1676 channel_input, /* inputProc */
1677 channel_output, /* outputProc */
1678 NULL, /* seekProc */
1679 NULL, /* setOptionProc */
1680 NULL, /* getOptionProc */
1681 channel_watch, /* watchProc */
1682 channel_gethandle, /* getHandleProc */
1683 NULL, /* close2Proc */
1684 NULL, /* blockModeProc */
1685 #ifdef TCL_CHANNEL_VERSION_2
1686 NULL, /* flushProc */
1687 NULL, /* handlerProc */
1688 #endif
1689 #ifdef TCL_CHANNEL_VERSION_3
1690 NULL, /* wideSeekProc */
1691 #endif
1692 #ifdef TCL_CHANNEL_VERSION_4
1693 NULL, /* threadActionProc */
1694 #endif
1695 #ifdef TCL_CHANNEL_VERSION_5
1696 NULL /* truncateProc */
1697 #endif
1700 /**********************************
1701 Interface to vim
1702 **********************************/
1704 static void
1705 tclupdatevars()
1707 char varname[VARNAME_SIZE]; /* must be writeable */
1708 char *name;
1710 strcpy(varname, VAR_RANGE1);
1711 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1712 strcpy(varname, VAR_RANGE2);
1713 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1714 strcpy(varname, VAR_RANGE3);
1715 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1717 strcpy(varname, VAR_LBASE);
1718 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1720 name = tclgetbuffer(tclinfo.interp, curbuf);
1721 strcpy(tclinfo.curbuf, name);
1722 strcpy(varname, VAR_CURBUF);
1723 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1725 name = tclgetwindow(tclinfo.interp, curwin);
1726 strcpy(tclinfo.curwin, name);
1727 strcpy(varname, VAR_CURWIN);
1728 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1732 static int
1733 tclinit(eap)
1734 exarg_T *eap;
1736 char varname[VARNAME_SIZE]; /* Tcl_LinkVar requires writeable varname */
1737 char *name;
1739 #ifdef DYNAMIC_TCL
1740 if (!tcl_enabled(TRUE))
1742 EMSG(_("E571: Sorry, this command is disabled: the Tcl library could not be loaded."));
1743 return FAIL;
1745 #endif
1747 if (!tclinfo.interp)
1749 Tcl_Interp *interp;
1750 static Tcl_Channel ch1, ch2;
1752 /* replace stdout and stderr */
1753 ch1 = Tcl_CreateChannel(&channel_type, "vimout", VIMOUT, TCL_WRITABLE);
1754 ch2 = Tcl_CreateChannel(&channel_type, "vimerr", VIMERR, TCL_WRITABLE);
1755 Tcl_SetStdChannel(ch1, TCL_STDOUT);
1756 Tcl_SetStdChannel(ch2, TCL_STDERR);
1758 interp = Tcl_CreateInterp();
1759 Tcl_Preserve(interp);
1760 if (Tcl_Init(interp) == TCL_ERROR)
1762 Tcl_Release(interp);
1763 Tcl_DeleteInterp(interp);
1764 return FAIL;
1766 #if 0
1767 /* VIM sure is interactive */
1768 Tcl_SetVar(interp, "tcl_interactive", "1", TCL_GLOBAL_ONLY);
1769 #endif
1771 Tcl_SetChannelOption(interp, ch1, "-buffering", "line");
1772 Tcl_SetChannelOption(interp, ch2, "-buffering", "line");
1774 /* replace some standard Tcl commands */
1775 Tcl_DeleteCommand(interp, "exit");
1776 Tcl_CreateObjCommand(interp, "exit", exitcmd,
1777 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1778 Tcl_DeleteCommand(interp, "catch");
1779 Tcl_CreateObjCommand(interp, "catch", catchcmd,
1780 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1782 /* new commands, in ::vim namespace */
1783 Tcl_CreateObjCommand(interp, "::vim::buffer", buffercmd,
1784 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1785 Tcl_CreateObjCommand(interp, "::vim::window", windowcmd,
1786 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1787 Tcl_CreateObjCommand(interp, "::vim::command", commandcmd,
1788 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1789 Tcl_CreateObjCommand(interp, "::vim::beep", beepcmd,
1790 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1791 Tcl_CreateObjCommand(interp, "::vim::option", optioncmd,
1792 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1793 Tcl_CreateObjCommand(interp, "::vim::expr", exprcmd,
1794 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1796 /* "lbase" variable */
1797 tclinfo.lbase = 1;
1798 strcpy(varname, VAR_LBASE);
1799 Tcl_LinkVar(interp, varname, (char *)&tclinfo.lbase, TCL_LINK_INT);
1801 /* "range" variable */
1802 tclinfo.range_start = eap->line1;
1803 strcpy(varname, VAR_RANGE1);
1804 Tcl_LinkVar(interp, varname, (char *)&tclinfo.range_start, TCL_LINK_INT|TCL_LINK_READ_ONLY);
1805 strcpy(varname, VAR_RANGE2);
1806 Tcl_LinkVar(interp, varname, (char *)&tclinfo.range_start, TCL_LINK_INT|TCL_LINK_READ_ONLY);
1807 tclinfo.range_end = eap->line2;
1808 strcpy(varname, VAR_RANGE3);
1809 Tcl_LinkVar(interp, varname, (char *)&tclinfo.range_end, TCL_LINK_INT|TCL_LINK_READ_ONLY);
1811 /* "current" variable */
1812 tclinfo.curbuf = Tcl_Alloc(VARNAME_SIZE);
1813 tclinfo.curwin = Tcl_Alloc(VARNAME_SIZE);
1814 name = tclgetbuffer(interp, curbuf);
1815 strcpy(tclinfo.curbuf, name);
1816 strcpy(varname, VAR_CURBUF);
1817 Tcl_LinkVar(interp, varname, (char *)&tclinfo.curbuf, TCL_LINK_STRING|TCL_LINK_READ_ONLY);
1818 name = tclgetwindow(interp, curwin);
1819 strcpy(tclinfo.curwin, name);
1820 strcpy(varname, VAR_CURWIN);
1821 Tcl_LinkVar(interp, varname, (char *)&tclinfo.curwin, TCL_LINK_STRING|TCL_LINK_READ_ONLY);
1823 tclinfo.interp = interp;
1825 else
1827 /* Interpreter already exists, just update variables */
1828 tclinfo.range_start = row2tcl(eap->line1);
1829 tclinfo.range_end = row2tcl(eap->line2);
1830 tclupdatevars();
1832 return OK;
1835 static void
1836 tclerrmsg(text)
1837 char *text;
1839 char *next;
1841 while ((next=strchr(text, '\n')))
1843 *next++ = '\0';
1844 EMSG(text);
1845 text = next;
1847 if (*text)
1848 EMSG(text);
1851 static void
1852 tclmsg(text)
1853 char *text;
1855 char *next;
1857 while ((next=strchr(text, '\n')))
1859 *next++ = '\0';
1860 MSG(text);
1861 text = next;
1863 if (*text)
1864 MSG(text);
1867 static void
1868 tcldelthisinterp()
1870 if (!Tcl_InterpDeleted(tclinfo.interp))
1871 Tcl_DeleteInterp(tclinfo.interp);
1872 Tcl_Release(tclinfo.interp);
1873 /* The interpreter is now gets deleted. All registered commands (esp.
1874 * window and buffer commands) are deleted, triggering their deletion
1875 * callback, which deletes all refs pointing to this interpreter.
1876 * We could garbage-collect the unused ref structs in all windows and
1877 * buffers, but unless the user creates hundreds of sub-interpreters
1878 * all referring to lots of windows and buffers, this is hardly worth
1879 * the effort. Unused refs are recycled by other interpreters, and
1880 * all refs are free'd when the window/buffer gets closed by vim.
1883 tclinfo.interp = NULL;
1884 Tcl_Free(tclinfo.curbuf);
1885 Tcl_Free(tclinfo.curwin);
1886 tclinfo.curbuf = tclinfo.curwin = NULL;
1889 static int
1890 tclexit(error)
1891 int error;
1893 int newerr = OK;
1895 if (error == TCL_EXIT )
1897 int retval;
1898 char buf[50];
1899 Tcl_Obj *robj;
1901 robj = Tcl_GetObjResult(tclinfo.interp);
1902 if( Tcl_GetIntFromObj(tclinfo.interp, robj, &retval) != TCL_OK )
1904 EMSG(_("E281: TCL ERROR: exit code is not int!? Please report this to vim-dev@vim.org"));
1905 newerr = FAIL;
1907 else
1909 sprintf(buf, _("E572: exit code %d"), retval);
1910 tclerrmsg(buf);
1911 if (retval == 0 )
1913 did_emsg = 0;
1914 newerr = OK;
1916 else
1917 newerr = FAIL;
1920 tcldelthisinterp();
1922 else
1924 char *result;
1926 result = (char *)Tcl_GetStringResult(tclinfo.interp);
1927 if (error == TCL_OK)
1929 tclmsg(result);
1930 newerr = OK;
1932 else
1934 tclerrmsg(result);
1935 newerr = FAIL;
1939 return newerr;
1943 * ":tcl"
1945 void
1946 ex_tcl(eap)
1947 exarg_T *eap;
1949 char_u *script;
1950 int err;
1952 script = script_get(eap, eap->arg);
1953 if (!eap->skip)
1955 err = tclinit(eap);
1956 if (err == OK)
1958 Tcl_AllowExceptions(tclinfo.interp);
1959 if (script == NULL)
1960 err = Tcl_Eval(tclinfo.interp, (char *)eap->arg);
1961 else
1962 err = Tcl_Eval(tclinfo.interp, (char *)script);
1963 err = tclexit(err);
1966 vim_free(script);
1970 * ":tclfile"
1972 void
1973 ex_tclfile(eap)
1974 exarg_T *eap;
1976 char *file = (char *)eap->arg;
1977 int err;
1979 err = tclinit(eap);
1980 if (err == OK)
1982 Tcl_AllowExceptions(tclinfo.interp);
1983 err = Tcl_EvalFile(tclinfo.interp, file);
1984 err = tclexit(err);
1989 * ":tcldo"
1991 void
1992 ex_tcldo(eap)
1993 exarg_T *eap;
1995 char *script, *line;
1996 int err, rs, re, lnum;
1997 char var_lnum[VARNAME_SIZE]; /* must be writeable memory */
1998 char var_line[VARNAME_SIZE];
1999 linenr_T first_line = 0;
2000 linenr_T last_line = 0;
2002 rs = eap->line1;
2003 re = eap->line2;
2004 script = (char *)eap->arg;
2005 strcpy(var_lnum, VAR_CURLNUM);
2006 strcpy(var_line, VAR_CURLINE);
2008 err = tclinit(eap);
2009 if (err != OK)
2010 return;
2012 lnum = row2tcl(rs);
2013 Tcl_LinkVar(tclinfo.interp, var_lnum, (char *)&lnum, TCL_LINK_INT|TCL_LINK_READ_ONLY);
2014 err = TCL_OK;
2015 if (u_save((linenr_T)(rs-1), (linenr_T)(re+1)) != OK)
2017 Tcl_SetResult(tclinfo.interp, _("cannot save undo information"), TCL_STATIC);
2018 err = TCL_ERROR;
2020 while (err == TCL_OK && rs <= re)
2022 line = (char *)ml_get_buf(curbuf, (linenr_T)rs, FALSE);
2023 if (!line)
2025 Tcl_SetResult(tclinfo.interp, _("cannot get line"), TCL_STATIC);
2026 err = TCL_ERROR;
2027 break;
2029 Tcl_SetVar(tclinfo.interp, var_line, line, 0);
2030 Tcl_AllowExceptions(tclinfo.interp);
2031 err = Tcl_Eval(tclinfo.interp, script);
2032 if (err != TCL_OK)
2033 break;
2034 line = (char *)Tcl_GetVar(tclinfo.interp, var_line, 0);
2035 if (line)
2037 if (ml_replace((linenr_T)rs, (char_u *)line, TRUE) != OK)
2039 Tcl_SetResult(tclinfo.interp, _("cannot replace line"), TCL_STATIC);
2040 err = TCL_ERROR;
2041 break;
2043 if (first_line == 0)
2044 first_line = rs;
2045 last_line = rs;
2047 ++rs;
2048 ++lnum;
2049 Tcl_UpdateLinkedVar(tclinfo.interp, var_lnum);
2051 if (first_line)
2052 changed_lines(first_line, 0, last_line + 1, (long)0);
2054 Tcl_UnsetVar(tclinfo.interp, var_line, 0);
2055 Tcl_UnlinkVar(tclinfo.interp, var_lnum);
2056 if (err == TCL_OK)
2057 Tcl_ResetResult(tclinfo.interp);
2059 (void)tclexit(err);
2062 static void
2063 tcldelallrefs(ref)
2064 struct ref *ref;
2066 struct ref *next;
2067 int err;
2068 char *result;
2070 while (ref != NULL)
2072 next = ref->next;
2073 if (ref->interp)
2075 if (ref->delcmd)
2077 err = Tcl_GlobalEvalObj(ref->interp, ref->delcmd);
2078 if (err != TCL_OK)
2080 result = (char *)Tcl_GetStringResult(ref->interp);
2081 if (result)
2082 tclerrmsg(result);
2084 Tcl_DecrRefCount(ref->delcmd);
2085 ref->delcmd = NULL;
2087 Tcl_DeleteCommandFromToken(ref->interp, ref->cmd);
2089 Tcl_Free((char *)ref);
2090 ref = next;
2094 void
2095 tcl_buffer_free(buf)
2096 buf_T *buf;
2098 struct ref *reflist;
2100 #ifdef DYNAMIC_TCL
2101 if (!stubs_initialized) /* Not using Tcl, nothing to do. */
2102 return;
2103 #endif
2105 reflist = (struct ref *)(buf->b_tcl_ref);
2106 if (reflist != &refsdeleted)
2108 buf->b_tcl_ref = (void *)&refsdeleted;
2109 tcldelallrefs(reflist);
2110 buf->b_tcl_ref = NULL;
2114 #if defined(FEAT_WINDOWS) || defined(PROTO)
2115 void
2116 tcl_window_free(win)
2117 win_T *win;
2119 struct ref *reflist;
2121 #ifdef DYNAMIC_TCL
2122 if (!stubs_initialized) /* Not using Tcl, nothing to do. */
2123 return;
2124 #endif
2126 reflist = (struct ref*)(win->w_tcl_ref);
2127 if (reflist != &refsdeleted)
2129 win->w_tcl_ref = (void *)&refsdeleted;
2130 tcldelallrefs(reflist);
2131 win->w_tcl_ref = NULL;
2134 #endif
2136 /* The End */