Merged from the latest developing branch.
[MacVim.git] / src / if_tcl.c
blobce00246bb5570e7d61224d302aeb92fd3d4853d9
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 perl.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 perl 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 /* ARGSUSED */
294 static int
295 exitcmd(dummy, interp, objc, objv)
296 ClientData dummy;
297 Tcl_Interp *interp;
298 int objc;
299 Tcl_Obj *CONST objv[];
301 int value = 0;
303 switch (objc)
305 case 2:
306 if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK)
307 break;
308 /* FALLTHROUGH */
309 case 1:
310 Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
311 return TCL_EXIT;
312 default:
313 Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
315 return TCL_ERROR;
318 /* ARGSUSED */
319 static int
320 catchcmd(dummy, interp, objc, objv)
321 ClientData dummy;
322 Tcl_Interp *interp;
323 int objc;
324 Tcl_Obj *CONST objv[];
326 char *varname = NULL;
327 int result;
329 switch (objc)
331 case 3:
332 varname = Tcl_GetStringFromObj(objv[2], NULL);
333 /* fallthrough */
334 case 2:
335 Tcl_ResetResult(interp);
336 Tcl_AllowExceptions(interp);
337 result = Tcl_EvalObj(interp, objv[1]);
338 if (result == TCL_EXIT)
339 return result;
340 if (varname)
342 if (Tcl_SetVar(interp, varname, Tcl_GetStringResult(interp), 0) == NULL)
344 Tcl_SetResult(interp, "couldn't save command result in variable", TCL_STATIC);
345 return TCL_ERROR;
348 Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
349 return TCL_OK;
350 default:
351 Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
353 return TCL_ERROR;
357 * "::vim::beep" - what Vi[m] does best :-)
359 /* ARGSUSED */
360 static int
361 beepcmd(dummy, interp, objc, objv)
362 ClientData dummy;
363 Tcl_Interp *interp;
364 int objc;
365 Tcl_Obj *CONST objv[];
367 if (objc != 1)
369 Tcl_WrongNumArgs(interp, 1, objv, NULL);
370 return TCL_ERROR;
372 vim_beep();
373 return TCL_OK;
377 * "::vim::buffer list" - create a list of buffer commands.
378 * "::vim::buffer {N}" - create buffer command for buffer N.
379 * "::vim::buffer new" - create a new buffer (not implemented)
381 /* ARGSUSED */
382 static int
383 buffercmd(dummy, interp, objc, objv)
384 ClientData dummy;
385 Tcl_Interp *interp;
386 int objc;
387 Tcl_Obj *CONST objv[];
389 char *name;
390 buf_T *buf;
391 Tcl_Obj *resobj;
392 int err, n, idx;
393 enum {BCMD_EXISTS, BCMD_LIST};
394 static CONST84 char *bcmdoptions[] =
396 "exists", "list", (char *)0
399 if (objc < 2)
401 Tcl_WrongNumArgs(interp, 1, objv, "option");
402 return TCL_ERROR;
404 err = Tcl_GetIntFromObj(interp, objv[1], &n);
405 if (err == TCL_OK)
407 if (objc != 2)
409 Tcl_WrongNumArgs(interp, 1, objv, "bufNumber");
410 return TCL_ERROR;
412 for (buf = firstbuf; buf != NULL; buf = buf->b_next)
414 if (buf->b_fnum == n)
416 name = tclgetbuffer(interp, buf);
417 if (name == NULL)
418 return TCL_ERROR;
419 Tcl_SetResult(interp, name, TCL_VOLATILE);
420 return TCL_OK;
423 Tcl_SetResult(interp, _("invalid buffer number"), TCL_STATIC);
424 return TCL_ERROR;
426 Tcl_ResetResult(interp); /* clear error from Tcl_GetIntFromObj */
428 err = Tcl_GetIndexFromObj(interp, objv[1], bcmdoptions, "option", 0, &idx);
429 if (err != TCL_OK)
430 return err;
431 switch (idx)
433 case BCMD_LIST:
434 if (objc != 2)
436 Tcl_WrongNumArgs(interp, 2, objv, "");
437 err = TCL_ERROR;
438 break;
440 for (buf = firstbuf; buf != NULL; buf = buf->b_next)
442 name = tclgetbuffer(interp, buf);
443 if (name == NULL)
445 err = TCL_ERROR;
446 break;
448 Tcl_AppendElement(interp, name);
450 break;
452 case BCMD_EXISTS:
453 if (objc != 3)
455 Tcl_WrongNumArgs(interp, 2, objv, "bufNumber");
456 err = TCL_ERROR;
457 break;
459 err = Tcl_GetIntFromObj(interp, objv[2], &n);
460 if (err == TCL_OK)
462 buf = buflist_findnr(n);
463 resobj = Tcl_NewIntObj(buf != NULL);
464 Tcl_SetObjResult(interp, resobj);
466 break;
468 default:
469 Tcl_SetResult(interp, _("not implemented yet"), TCL_STATIC);
470 err = TCL_ERROR;
472 return err;
476 * "::vim::window list" - create list of window commands.
478 /* ARGSUSED */
479 static int
480 windowcmd(dummy, interp, objc, objv)
481 ClientData dummy;
482 Tcl_Interp *interp;
483 int objc;
484 Tcl_Obj *CONST objv[];
486 char *what, *string;
487 win_T *win;
489 if (objc != 2)
491 Tcl_WrongNumArgs(interp, 1, objv, "option");
492 return TCL_ERROR;
494 what = Tcl_GetStringFromObj(objv[1], NULL);
495 if (strcmp(what, "list") == 0)
497 FOR_ALL_WINDOWS(win)
499 string = tclgetwindow(interp, win);
500 if (string == NULL)
501 return TCL_ERROR;
502 Tcl_AppendElement(interp, string);
504 return TCL_OK;
506 Tcl_SetResult(interp, _("unknown option"), TCL_STATIC);
507 return TCL_ERROR;
511 * flags for bufselfcmd and winselfcmd to indicate outstanding actions.
513 #define FL_UPDATE_SCREEN (1<<0)
514 #define FL_UPDATE_CURBUF (1<<1)
515 #define FL_ADJUST_CURSOR (1<<2)
518 * This function implements the buffer commands.
520 static int
521 bufselfcmd(ref, interp, objc, objv)
522 ClientData ref;
523 Tcl_Interp *interp;
524 int objc;
525 Tcl_Obj *CONST objv[];
527 int opt, err, idx, flags;
528 int val1, val2, n, i;
529 buf_T *buf, *savebuf;
530 win_T *win, *savewin;
531 Tcl_Obj *resobj;
532 pos_T *pos;
533 char *line;
535 enum
537 BUF_APPEND, BUF_COMMAND, BUF_COUNT, BUF_DELCMD, BUF_DELETE, BUF_EXPR,
538 BUF_GET, BUF_INSERT, BUF_LAST, BUF_MARK, BUF_NAME, BUF_NUMBER,
539 BUF_OPTION, BUF_SET, BUF_WINDOWS
541 static CONST84 char *bufoptions[] =
543 "append", "command", "count", "delcmd", "delete", "expr",
544 "get", "insert", "last", "mark", "name", "number",
545 "option", "set", "windows", (char *)0
548 if (objc < 2)
550 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
551 return TCL_ERROR;
554 err = Tcl_GetIndexFromObj(interp, objv[1], bufoptions, "option", 0, &idx);
555 if (err != TCL_OK)
556 return err;
558 buf = (buf_T *)((struct ref *)ref)->vimobj;
559 savebuf = curbuf; curbuf = buf;
560 savewin = curwin; curwin = tclfindwin(buf);
561 flags = 0;
562 opt = 0;
564 switch (idx)
566 case BUF_COMMAND:
567 err = tcldoexcommand(interp, objc, objv, 2);
568 flags |= FL_UPDATE_SCREEN;
569 break;
571 case BUF_OPTION:
572 err = tclsetoption(interp, objc, objv, 2);
573 flags |= FL_UPDATE_SCREEN;
574 break;
576 case BUF_EXPR:
577 err = tclvimexpr(interp, objc, objv, 2);
578 break;
580 case BUF_NAME:
582 * Get filename of buffer.
584 if (objc != 2)
586 Tcl_WrongNumArgs(interp, 2, objv, NULL);
587 err = TCL_ERROR;
588 break;
590 if (buf->b_ffname)
591 Tcl_SetResult(interp, (char *)buf->b_ffname, TCL_VOLATILE);
592 else
593 Tcl_SetResult(interp, "", TCL_STATIC);
594 break;
596 case BUF_LAST:
598 * Get line number of last line.
600 opt = 1;
601 /* fallthrough */
602 case BUF_COUNT:
604 * Get number of lines in buffer.
606 if (objc != 2)
608 Tcl_WrongNumArgs(interp, 2, objv, NULL);
609 err = TCL_ERROR;
610 break;
612 val1 = (int)buf->b_ml.ml_line_count;
613 if (opt)
614 val1 = row2tcl(val1);
616 resobj = Tcl_NewIntObj(val1);
617 Tcl_SetObjResult(interp, resobj);
618 break;
620 case BUF_NUMBER:
622 * Get buffer's number.
624 if (objc != 2)
626 Tcl_WrongNumArgs(interp, 2, objv, NULL);
627 err = TCL_ERROR;
628 break;
630 resobj = Tcl_NewIntObj((int)buf->b_fnum);
631 Tcl_SetObjResult(interp, resobj);
632 break;
634 case BUF_GET:
635 if (objc != 3 && objc != 4)
637 Tcl_WrongNumArgs(interp, 2, objv, "lineNumber ?lineNumber?");
638 err = TCL_ERROR;
639 break;
641 err = tclgetlinenum(interp, objv[2], &val1, buf);
642 if (err != TCL_OK)
643 break;
644 if (objc == 4)
646 err = tclgetlinenum(interp, objv[3], &val2, buf);
647 if (err != TCL_OK)
648 break;
649 if (val1 > val2)
651 n = val1; val1 = val2; val2 = n;
653 Tcl_ResetResult(interp);
655 for (n = val1; n <= val2 && err == TCL_OK; n++)
657 line = (char *)ml_get_buf(buf, (linenr_T)n, FALSE);
658 if (line)
659 Tcl_AppendElement(interp, line);
660 else
661 err = TCL_ERROR;
664 else { /* objc == 3 */
665 line = (char *)ml_get_buf(buf, (linenr_T)val1, FALSE);
666 Tcl_SetResult(interp, line, TCL_VOLATILE);
668 break;
670 case BUF_SET:
671 if (objc != 4 && objc != 5)
673 Tcl_WrongNumArgs(interp, 3, objv, "lineNumber ?lineNumber? stringOrList");
674 err = TCL_ERROR;
675 break;
677 err = tclgetlinenum(interp, objv[2], &val1, buf);
678 if (err != TCL_OK)
679 return TCL_ERROR;
680 if (objc == 4)
683 * Replace one line with a string.
684 * $buf set {n} {string}
686 line = Tcl_GetStringFromObj(objv[3], NULL);
687 if (u_savesub((linenr_T)val1) != OK)
689 Tcl_SetResult(interp, _("cannot save undo information"), TCL_STATIC);
690 err = TCL_ERROR;
692 else
693 if (ml_replace((linenr_T)val1, (char_u *)line, TRUE) != OK)
695 Tcl_SetResult(interp, _("cannot replace line"), TCL_STATIC);
696 err = TCL_ERROR;
698 else
700 changed_bytes((linenr_T)val1, 0);
701 flags |= FL_UPDATE_CURBUF;
703 break;
705 else
708 * Replace several lines with the elements of a Tcl list.
709 * $buf set {n} {m} {list}
710 * If the list contains more than {m}-{n}+1 elements, they
711 * are * inserted after line {m}. If the list contains fewer
712 * elements, * the lines from {n}+length({list}) through {m}
713 * are deleted.
715 int lc;
716 Tcl_Obj **lv;
718 err = tclgetlinenum(interp, objv[3], &val2, buf);
719 if (err != TCL_OK)
720 break;
721 err = Tcl_ListObjGetElements(interp, objv[4], &lc, &lv);
722 if (err != TCL_OK)
723 break;
724 if (val1 > val2)
726 n = val1;
727 val1 = val2;
728 val2 = n;
731 n = val1;
732 if (u_save((linenr_T)(val1 - 1), (linenr_T)(val2 + 1)) != OK)
734 Tcl_SetResult(interp, _("cannot save undo information"),
735 TCL_STATIC);
736 err = TCL_ERROR;
737 break;
739 flags |= FL_UPDATE_CURBUF;
741 for (i = 0; i < lc && n <= val2; i++)
743 line = Tcl_GetStringFromObj(lv[i], NULL);
744 if (ml_replace((linenr_T)n, (char_u *)line, TRUE) != OK)
745 goto setListError;
746 ++n;
748 if (i < lc)
750 /* append lines */
753 line = Tcl_GetStringFromObj(lv[i], NULL);
754 if (ml_append((linenr_T)(n - 1),
755 (char_u *)line, 0, FALSE) != OK)
756 goto setListError;
757 ++n;
758 ++i;
759 } while (i < lc);
761 else if (n <= val2)
763 /* did not replace all lines, delete */
764 i = n;
767 if (ml_delete((linenr_T)i, FALSE) != OK)
768 goto setListError;
769 ++n;
770 } while (n <= val2);
772 lc -= val2 - val1 + 1; /* number of lines to be replaced */
773 mark_adjust((linenr_T)val1, (linenr_T)val2, (long)MAXLNUM,
774 (long)lc);
775 changed_lines((linenr_T)val1, 0, (linenr_T)val2 + 1, (long)lc);
776 break;
777 setListError:
778 u_undo(1); /* ??? */
779 Tcl_SetResult(interp, _("cannot set line(s)"), TCL_STATIC);
780 err = TCL_ERROR;
782 break;
784 case BUF_DELETE:
785 if (objc != 3 && objc != 4)
787 Tcl_WrongNumArgs(interp, 3, objv, "lineNumber ?lineNumber?");
788 err = TCL_ERROR;
789 break;
791 err = tclgetlinenum(interp, objv[2], &val1, buf);
792 if (err != TCL_OK)
793 break;
794 val2 = val1;
795 if (objc == 4)
797 err = tclgetlinenum(interp, objv[3], &val2, buf);
798 if (err != TCL_OK)
799 return err;
800 if (val1 > val2)
802 i = val1; val1 = val2; val2 = i;
805 n = val2 - val1 + 1;
806 if (u_savedel((linenr_T)val1, (long)n) != OK)
808 Tcl_SetResult(interp, _("cannot save undo information"),
809 TCL_STATIC);
810 err = TCL_ERROR;
811 break;
813 for (i = 0; i < n; i++)
815 ml_delete((linenr_T)val1, FALSE);
816 err = vimerror(interp);
817 if (err != TCL_OK)
818 break;
820 if (i > 0)
821 deleted_lines_mark((linenr_T)val1, (long)i);
822 flags |= FL_ADJUST_CURSOR|FL_UPDATE_SCREEN;
823 break;
825 case BUF_MARK:
826 if (objc != 3)
828 Tcl_WrongNumArgs(interp, 2, objv, "markName");
829 err = TCL_ERROR;
830 break;
832 line = Tcl_GetStringFromObj(objv[2], NULL);
834 pos = NULL;
835 if (line[0] != '\0' && line[1] == '\0')
837 pos = getmark(line[0], FALSE);
839 if (pos == NULL)
841 Tcl_SetResult(interp, _("invalid mark name"), TCL_STATIC);
842 err = TCL_ERROR;
843 break;
845 err = vimerror(interp);
846 if (err != TCL_OK)
847 break;
848 if (pos->lnum <= 0)
850 Tcl_SetResult(interp, _("mark not set"), TCL_STATIC);
851 err = TCL_ERROR;
853 else
855 char rbuf[64];
857 sprintf(rbuf, _("row %d column %d"),
858 (int)row2tcl(pos->lnum), (int)col2tcl(pos->col));
859 Tcl_SetResult(interp, rbuf, TCL_VOLATILE);
861 break;
863 case BUF_INSERT:
864 opt = 1;
865 /* fallthrough */
866 case BUF_APPEND:
867 if (objc != 4)
869 Tcl_WrongNumArgs(interp, 2, objv, "lineNum text");
870 err = TCL_ERROR;
871 break;
873 err = tclgetlinenum(interp, objv[2], &val1, buf);
874 if (err != TCL_OK)
875 break;
876 if (opt)
877 --val1;
878 if (u_save((linenr_T)val1, (linenr_T)(val1+1)) != OK)
880 Tcl_SetResult(interp, _("cannot save undo information"),
881 TCL_STATIC);
882 err = TCL_ERROR;
883 break;
886 line = Tcl_GetStringFromObj(objv[3], NULL);
887 if (ml_append((linenr_T)val1, (char_u *)line, 0, FALSE) != OK)
889 Tcl_SetResult(interp, _("cannot insert/append line"),
890 TCL_STATIC);
891 err = TCL_ERROR;
892 break;
894 appended_lines_mark((linenr_T)val1, 1L);
895 flags |= FL_UPDATE_SCREEN;
896 break;
898 case BUF_WINDOWS:
900 * Return list of window commands.
902 if (objc != 2)
904 Tcl_WrongNumArgs(interp, 2, objv, NULL);
905 err = TCL_ERROR;
906 break;
908 Tcl_ResetResult(interp);
909 FOR_ALL_WINDOWS(win)
911 if (win->w_buffer == buf)
913 line = tclgetwindow(interp, win);
914 if (line != NULL)
915 Tcl_AppendElement(interp, line);
916 else
918 err = TCL_ERROR;
919 break;
923 break;
925 case BUF_DELCMD:
927 * Register deletion callback.
928 * TODO: Should be able to register multiple callbacks
930 if (objc != 3)
932 Tcl_WrongNumArgs(interp, 2, objv, "command");
933 err = TCL_ERROR;
934 break;
936 err = tclsetdelcmd(interp, buf->b_tcl_ref, (void *)buf, objv[2]);
937 break;
939 default:
940 Tcl_SetResult(interp, _("not implemented yet"), TCL_STATIC);
941 err = TCL_ERROR;
944 if (flags & FL_UPDATE_CURBUF)
945 redraw_curbuf_later(NOT_VALID);
946 curbuf = savebuf;
947 curwin = savewin;
948 if (flags & FL_ADJUST_CURSOR)
949 check_cursor();
950 if (flags & (FL_UPDATE_SCREEN | FL_UPDATE_CURBUF))
951 update_screen(NOT_VALID);
953 return err;
957 * This function implements the window commands.
959 static int
960 winselfcmd(ref, interp, objc, objv)
961 ClientData ref;
962 Tcl_Interp *interp;
963 int objc;
964 Tcl_Obj *CONST objv[];
966 int err, idx, flags;
967 int val1, val2;
968 Tcl_Obj *resobj;
969 win_T *savewin, *win;
970 buf_T *savebuf;
971 char *str;
973 enum
975 WIN_BUFFER, WIN_COMMAND, WIN_CURSOR, WIN_DELCMD, WIN_EXPR,
976 WIN_HEIGHT, WIN_OPTION
978 static CONST84 char *winoptions[] =
980 "buffer", "command", "cursor", "delcmd", "expr",
981 "height", "option", (char *)0
984 if (objc < 2)
986 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
987 return TCL_ERROR;
990 err = Tcl_GetIndexFromObj(interp, objv[1], winoptions, "option", 0, &idx);
991 if (err != TCL_OK)
992 return TCL_ERROR;
994 win = (win_T *)((struct ref *)ref)->vimobj;
995 savewin = curwin; curwin = win;
996 savebuf = curbuf; curbuf = win->w_buffer;
997 flags = 0;
999 switch (idx)
1001 case WIN_OPTION:
1002 err = tclsetoption(interp, objc, objv, 2);
1003 flags |= FL_UPDATE_SCREEN;
1004 break;
1006 case WIN_COMMAND:
1007 err = tcldoexcommand(interp, objc, objv, 2);
1008 flags |= FL_UPDATE_SCREEN;
1009 break;
1011 case WIN_EXPR:
1012 err = tclvimexpr(interp, objc, objv, 2);
1013 break;
1015 case WIN_HEIGHT:
1016 if (objc == 3)
1018 err = Tcl_GetIntFromObj(interp, objv[2], &val1);
1019 if (err != TCL_OK)
1020 break;
1021 #ifdef FEAT_GUI
1022 need_mouse_correct = TRUE;
1023 #endif
1024 win_setheight(val1);
1025 err = vimerror(interp);
1026 if (err != TCL_OK)
1027 break;
1029 else
1030 if (objc != 2)
1032 Tcl_WrongNumArgs(interp, 2, objv, "?value?");
1033 err = TCL_ERROR;
1034 break;
1037 resobj = Tcl_NewIntObj((int)(win->w_height));
1038 Tcl_SetObjResult(interp, resobj);
1039 break;
1041 case WIN_BUFFER:
1042 if (objc != 2)
1044 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1045 err = TCL_ERROR;
1046 break;
1048 str = tclgetbuffer(interp, win->w_buffer);
1049 if (str)
1050 Tcl_SetResult(interp, str, TCL_VOLATILE);
1051 else
1052 err = TCL_ERROR;
1053 break;
1055 case WIN_DELCMD:
1056 if (objc != 3)
1058 Tcl_WrongNumArgs(interp, 2, objv, "command");
1059 err = TCL_ERROR;
1060 break;
1062 err = tclsetdelcmd(interp, win->w_tcl_ref, (void *)win, objv[2]);
1063 break;
1065 case WIN_CURSOR:
1066 if (objc > 4)
1068 Tcl_WrongNumArgs(interp, 2, objv, "?arg1 ?arg2??");
1069 err = TCL_ERROR;
1070 break;
1072 if (objc == 2)
1074 char buf[64];
1076 sprintf(buf, _("row %d column %d"), (int)row2tcl(win->w_cursor.lnum), (int)col2tcl(win->w_cursor.col));
1077 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1078 break;
1080 else if (objc == 3)
1082 Tcl_Obj *part, *var;
1084 part = Tcl_NewStringObj("row", -1);
1085 var = Tcl_ObjGetVar2(interp, objv[2], part, TCL_LEAVE_ERR_MSG);
1086 if (var == NULL)
1088 err = TCL_ERROR;
1089 break;
1091 err = tclgetlinenum(interp, var, &val1, win->w_buffer);
1092 if (err != TCL_OK)
1093 break;
1094 part = Tcl_NewStringObj("column", -1);
1095 var = Tcl_ObjGetVar2(interp, objv[2], part, TCL_LEAVE_ERR_MSG);
1096 if (var == NULL)
1098 err = TCL_ERROR;
1099 break;
1101 err = Tcl_GetIntFromObj(interp, var, &val2);
1102 if (err != TCL_OK)
1103 break;
1105 else { /* objc == 4 */
1106 err = tclgetlinenum(interp, objv[2], &val1, win->w_buffer);
1107 if (err != TCL_OK)
1108 break;
1109 err = Tcl_GetIntFromObj(interp, objv[3], &val2);
1110 if (err != TCL_OK)
1111 break;
1113 /* TODO: should check column */
1114 win->w_cursor.lnum = val1;
1115 win->w_cursor.col = col2vim(val2);
1116 flags |= FL_UPDATE_SCREEN;
1117 break;
1119 default:
1120 Tcl_SetResult(interp, _("not implemented yet"), TCL_STATIC);
1121 break;
1124 curwin = savewin;
1125 curbuf = savebuf;
1126 if (flags & FL_UPDATE_SCREEN)
1127 update_screen(NOT_VALID);
1129 return err;
1133 /* ARGSUSED */
1134 static int
1135 commandcmd(dummy, interp, objc, objv)
1136 ClientData dummy;
1137 Tcl_Interp *interp;
1138 int objc;
1139 Tcl_Obj *CONST objv[];
1141 int err;
1143 err = tcldoexcommand(interp, objc, objv, 1);
1144 update_screen(VALID);
1145 return err;
1148 /* ARGSUSED */
1149 static int
1150 optioncmd(dummy, interp, objc, objv)
1151 ClientData dummy;
1152 Tcl_Interp *interp;
1153 int objc;
1154 Tcl_Obj *CONST objv[];
1156 int err;
1158 err = tclsetoption(interp, objc, objv, 1);
1159 update_screen(VALID);
1160 return err;
1163 /* ARGSUSED */
1164 static int
1165 exprcmd(dummy, interp, objc, objv)
1166 ClientData dummy;
1167 Tcl_Interp *interp;
1168 int objc;
1169 Tcl_Obj *CONST objv[];
1171 return tclvimexpr(interp, objc, objv, 1);
1174 /****************************************************************************
1175 Support functions for Tcl commands
1176 ****************************************************************************/
1179 * Get a line number from 'obj' and convert it to vim's range.
1181 static int
1182 tclgetlinenum(interp, obj, valueP, buf)
1183 Tcl_Interp *interp;
1184 Tcl_Obj *obj;
1185 int *valueP;
1186 buf_T *buf;
1188 int err, i;
1190 enum { LN_BEGIN, LN_BOTTOM, LN_END, LN_FIRST, LN_LAST, LN_START, LN_TOP };
1192 static CONST84 char *keyw[] =
1194 "begin", "bottom", "end", "first", "last", "start", "top", (char *)0
1197 err = Tcl_GetIndexFromObj(interp, obj, keyw, "", 0, &i);
1198 if (err == TCL_OK)
1200 switch (i)
1202 case LN_BEGIN:
1203 case LN_FIRST:
1204 case LN_START:
1205 case LN_TOP:
1206 *valueP = 1;
1207 break;
1208 case LN_BOTTOM:
1209 case LN_END:
1210 case LN_LAST:
1211 *valueP = buf->b_ml.ml_line_count;
1212 break;
1214 return TCL_OK;
1216 Tcl_ResetResult(interp);
1218 err = Tcl_GetIntFromObj(interp, obj, &i);
1219 if (err != TCL_OK)
1220 return err;
1221 i = row2vim(i);
1222 if (i < 1 || i > buf->b_ml.ml_line_count)
1224 Tcl_SetResult(interp, _("line number out of range"), TCL_STATIC);
1225 return TCL_ERROR;
1227 *valueP = i;
1228 return TCL_OK;
1232 * Find the first window in the window list that displays the buffer.
1234 static win_T *
1235 tclfindwin(buf)
1236 buf_T *buf;
1238 win_T *win;
1240 FOR_ALL_WINDOWS(win)
1242 if (win->w_buffer == buf)
1243 return win;
1245 return curwin; /* keep current window context */
1249 * Do-it-all function for "::vim::command", "$buf command" and "$win command".
1251 static int
1252 tcldoexcommand(interp, objc, objv, objn)
1253 Tcl_Interp *interp;
1254 int objc;
1255 Tcl_Obj *CONST objv[];
1256 int objn;
1258 tcl_info saveinfo;
1259 int err, flag, nobjs;
1260 char *arg;
1262 nobjs = objc - objn;
1263 if (nobjs < 1 || nobjs > 2)
1265 Tcl_WrongNumArgs(interp, objn, objv, "?-quiet? exCommand");
1266 return TCL_ERROR;
1269 flag = 0;
1270 if (nobjs == 2)
1272 arg = Tcl_GetStringFromObj(objv[objn], NULL);
1273 if (strcmp(arg, "-quiet") == 0)
1274 flag = 1;
1275 else
1277 Tcl_ResetResult(interp);
1278 Tcl_AppendResult(interp, _("unknown flag: "), arg, (char *)0);
1279 return TCL_ERROR;
1281 ++objn;
1284 memcpy(&saveinfo, &tclinfo, sizeof(tcl_info));
1285 tclinfo.interp = NULL;
1286 tclinfo.curwin = NULL;
1287 tclinfo.curbuf = NULL;
1289 arg = Tcl_GetStringFromObj(objv[objn], NULL);
1290 if (flag)
1291 ++emsg_off;
1292 do_cmdline_cmd((char_u *)arg);
1293 if (flag)
1294 --emsg_off;
1295 err = vimerror(interp);
1297 /* If the ex command created a new Tcl interpreter, remove it */
1298 if (tclinfo.interp)
1299 tcldelthisinterp();
1300 memcpy(&tclinfo, &saveinfo, sizeof(tcl_info));
1301 tclupdatevars();
1303 return err;
1307 * Do-it-all function for "::vim::option", "$buf option" and "$win option".
1309 static int
1310 tclsetoption(interp, objc, objv, objn)
1311 Tcl_Interp *interp;
1312 int objc;
1313 Tcl_Obj *CONST objv[];
1314 int objn;
1316 int err, nobjs, idx;
1317 char_u *option;
1318 int isnum;
1319 long lval;
1320 char_u *sval;
1321 Tcl_Obj *resobj;
1323 enum { OPT_OFF, OPT_ON, OPT_TOGGLE };
1324 static CONST84 char *optkw[] = { "off", "on", "toggle", (char *)0 };
1326 nobjs = objc - objn;
1327 if (nobjs != 1 && nobjs != 2)
1329 Tcl_WrongNumArgs(interp, objn, objv, "vimOption ?value?");
1330 return TCL_ERROR;
1333 option = (char_u *)Tcl_GetStringFromObj(objv[objn], NULL);
1334 ++objn;
1335 isnum = get_option_value(option, &lval, &sval, 0);
1336 err = TCL_OK;
1337 switch (isnum)
1339 case 0:
1340 Tcl_SetResult(interp, (char *)sval, TCL_VOLATILE);
1341 vim_free(sval);
1342 break;
1343 case 1:
1344 resobj = Tcl_NewLongObj(lval);
1345 Tcl_SetObjResult(interp, resobj);
1346 break;
1347 default:
1348 Tcl_SetResult(interp, _("unknown vimOption"), TCL_STATIC);
1349 return TCL_ERROR;
1351 if (nobjs == 2)
1353 if (isnum)
1355 sval = NULL; /* avoid compiler warning */
1356 err = Tcl_GetIndexFromObj(interp, objv[objn], optkw, "", 0, &idx);
1357 if (err != TCL_OK)
1359 Tcl_ResetResult(interp);
1360 err = Tcl_GetLongFromObj(interp, objv[objn], &lval);
1362 else
1363 switch (idx)
1365 case OPT_ON:
1366 lval = 1;
1367 break;
1368 case OPT_OFF:
1369 lval = 0;
1370 break;
1371 case OPT_TOGGLE:
1372 lval = !lval;
1373 break;
1376 else
1377 sval = (char_u *)Tcl_GetStringFromObj(objv[objn], NULL);
1378 if (err == TCL_OK)
1380 set_option_value(option, lval, sval, OPT_LOCAL);
1381 err = vimerror(interp);
1384 return err;
1388 * Do-it-all function for "::vim::expr", "$buf expr" and "$win expr".
1390 static int
1391 tclvimexpr(interp, objc, objv, objn)
1392 Tcl_Interp *interp;
1393 int objc;
1394 Tcl_Obj *CONST objv[];
1395 int objn;
1397 #ifdef FEAT_EVAL
1398 char *expr, *str;
1399 #endif
1400 int err;
1402 if (objc - objn != 1)
1404 Tcl_WrongNumArgs(interp, objn, objv, "vimExpr");
1405 return TCL_ERROR;
1408 #ifdef FEAT_EVAL
1409 expr = Tcl_GetStringFromObj(objv[objn], NULL);
1410 str = (char *)eval_to_string((char_u *)expr, NULL, TRUE);
1411 if (str == NULL)
1412 Tcl_SetResult(interp, _("invalid expression"), TCL_STATIC);
1413 else
1414 Tcl_SetResult(interp, str, TCL_VOLATILE);
1415 err = vimerror(interp);
1416 #else
1417 Tcl_SetResult(interp, _("expressions disabled at compile time"), TCL_STATIC);
1418 err = TCL_ERROR;
1419 #endif
1421 return err;
1425 * Check for internal vim errors.
1427 static int
1428 vimerror(interp)
1429 Tcl_Interp *interp;
1431 if (got_int)
1433 Tcl_SetResult(interp, _("keyboard interrupt"), TCL_STATIC);
1434 return TCL_ERROR;
1436 else if (did_emsg)
1438 Tcl_SetResult(interp, _("vim error"), TCL_STATIC);
1439 return TCL_ERROR;
1441 return TCL_OK;
1445 * Functions that handle the reference lists:
1446 * delref() - callback for Tcl's DeleteCommand
1447 * tclgetref() - find/create Tcl command for a win_T* or buf_T* object
1448 * tclgetwindow() - window frontend for tclgetref()
1449 * tclgetbuffer() - buffer frontend for tclgetref()
1450 * tclsetdelcmd() - add Tcl callback command to a vim object
1452 static void
1453 delref(cref)
1454 ClientData cref;
1456 struct ref *ref = (struct ref *)cref;
1458 if (ref->delcmd)
1460 Tcl_DecrRefCount(ref->delcmd);
1461 ref->delcmd = NULL;
1463 ref->interp = NULL;
1466 static char *
1467 tclgetref(interp, refstartP, prefix, vimobj, proc)
1468 Tcl_Interp *interp;
1469 void **refstartP; /* ptr to w_tcl_ref/b_tcl-ref member of
1470 win_T/buf_T struct */
1471 char *prefix; /* "win" or "buf" */
1472 void *vimobj; /* win_T* or buf_T* */
1473 Tcl_ObjCmdProc *proc; /* winselfcmd or bufselfcmd */
1475 struct ref *ref, *unused = NULL;
1476 static char name[VARNAME_SIZE];
1477 Tcl_Command cmd;
1479 ref = (struct ref *)(*refstartP);
1480 if (ref == &refsdeleted)
1482 Tcl_SetResult(interp, _("cannot create buffer/window command: object is being deleted"), TCL_STATIC);
1483 return NULL;
1486 while (ref != NULL)
1488 if (ref->interp == interp)
1489 break;
1490 if (ref->interp == NULL)
1491 unused = ref;
1492 ref = ref->next;
1495 if (ref)
1496 vim_snprintf(name, sizeof(name), "::vim::%s",
1497 Tcl_GetCommandName(interp, ref->cmd));
1498 else
1500 if (unused)
1501 ref = unused;
1502 else
1504 ref = (struct ref *)Tcl_Alloc(sizeof(struct ref));
1505 #if 0 /* Tcl_Alloc either succeeds or does not return */
1506 if (!ref)
1508 Tcl_SetResult(interp, "out of memory", TCL_STATIC);
1509 return NULL;
1511 #endif
1512 ref->interp = NULL;
1513 ref->next = (struct ref *)(*refstartP);
1514 (*refstartP) = (void *)ref;
1517 /* This might break on some exotic systems... */
1518 vim_snprintf(name, sizeof(name), "::vim::%s_%lx",
1519 prefix, (unsigned long)vimobj);
1520 cmd = Tcl_CreateObjCommand(interp, name, proc,
1521 (ClientData)ref, (Tcl_CmdDeleteProc *)delref);
1522 if (!cmd)
1523 return NULL;
1525 ref->interp = interp;
1526 ref->cmd = cmd;
1527 ref->delcmd = NULL;
1528 ref->vimobj = vimobj;
1530 return name;
1533 static char *
1534 tclgetwindow(interp, win)
1535 Tcl_Interp *interp;
1536 win_T *win;
1538 return tclgetref(interp, &(win->w_tcl_ref), "win", (void *)win, winselfcmd);
1541 static char *
1542 tclgetbuffer(interp, buf)
1543 Tcl_Interp *interp;
1544 buf_T *buf;
1546 return tclgetref(interp, &(buf->b_tcl_ref), "buf", (void *)buf, bufselfcmd);
1549 static int
1550 tclsetdelcmd(interp, reflist, vimobj, delcmd)
1551 Tcl_Interp *interp;
1552 struct ref *reflist;
1553 void *vimobj;
1554 Tcl_Obj *delcmd;
1556 if (reflist == &refsdeleted)
1558 Tcl_SetResult(interp, _("cannot register callback command: buffer/window is already being deleted"), TCL_STATIC);
1559 return TCL_ERROR;
1562 while (reflist != NULL)
1564 if (reflist->interp == interp && reflist->vimobj == vimobj)
1566 if (reflist->delcmd)
1568 Tcl_DecrRefCount(reflist->delcmd);
1570 Tcl_IncrRefCount(delcmd);
1571 reflist->delcmd = delcmd;
1572 return TCL_OK;
1574 reflist = reflist->next;
1576 /* This should never happen. Famous last word? */
1577 EMSG(_("E280: TCL FATAL ERROR: reflist corrupt!? Please report this to vim-dev@vim.org"));
1578 Tcl_SetResult(interp, _("cannot register callback command: buffer/window reference not found"), TCL_STATIC);
1579 return TCL_ERROR;
1583 /*******************************************
1584 I/O Channel
1585 ********************************************/
1587 /* ARGSUSED */
1588 static int
1589 channel_close(instance, interp)
1590 ClientData instance;
1591 Tcl_Interp *interp;
1593 int err = 0;
1595 /* currently does nothing */
1597 if (instance != VIMOUT && instance != VIMERR)
1599 Tcl_SetErrno(EBADF);
1600 err = EBADF;
1602 return err;
1605 /* ARGSUSED */
1606 static int
1607 channel_input(instance, buf, bufsiz, errptr)
1608 ClientData instance;
1609 char *buf;
1610 int bufsiz;
1611 int *errptr;
1614 /* input is currently not supported */
1616 Tcl_SetErrno(EINVAL);
1617 if (errptr)
1618 *errptr = EINVAL;
1619 return -1;
1622 static int
1623 channel_output(instance, buf, bufsiz, errptr)
1624 ClientData instance;
1625 char *buf;
1626 int bufsiz;
1627 int *errptr;
1629 char_u *str;
1630 int result;
1632 /* The buffer is not guaranteed to be 0-terminated, and we don't if
1633 * there is enough room to add a '\0'. So we have to create a copy
1634 * of the buffer...
1636 str = vim_strnsave((char_u *)buf, bufsiz);
1637 if (!str)
1639 Tcl_SetErrno(ENOMEM);
1640 if (errptr)
1641 *errptr = ENOMEM;
1642 return -1;
1645 result = bufsiz;
1646 if (instance == VIMOUT)
1647 tclmsg((char *)str);
1648 else
1649 if (instance == VIMERR)
1650 tclerrmsg((char *)str);
1651 else
1653 Tcl_SetErrno(EBADF);
1654 if (errptr)
1655 *errptr = EBADF;
1656 result = -1;
1658 vim_free(str);
1659 return result;
1662 /* ARGSUSED */
1663 static void
1664 channel_watch(instance, mask)
1665 ClientData instance;
1666 int mask;
1668 Tcl_SetErrno(EINVAL);
1671 /* ARGSUSED */
1672 static int
1673 channel_gethandle(instance, direction, handleptr)
1674 ClientData instance;
1675 int direction;
1676 ClientData *handleptr;
1678 Tcl_SetErrno(EINVAL);
1679 return EINVAL;
1683 static Tcl_ChannelType channel_type =
1685 "vimmessage",
1686 NULL, /* blockmode */
1687 channel_close,
1688 channel_input,
1689 channel_output,
1690 NULL, /* seek */
1691 NULL, /* set option */
1692 NULL, /* get option */
1693 channel_watch,
1694 channel_gethandle
1697 /**********************************
1698 Interface to vim
1699 **********************************/
1701 static void
1702 tclupdatevars()
1704 char varname[VARNAME_SIZE]; /* must be writeable */
1705 char *name;
1707 strcpy(varname, VAR_RANGE1);
1708 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1709 strcpy(varname, VAR_RANGE2);
1710 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1711 strcpy(varname, VAR_RANGE3);
1712 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1714 strcpy(varname, VAR_LBASE);
1715 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1717 name = tclgetbuffer(tclinfo.interp, curbuf);
1718 strcpy(tclinfo.curbuf, name);
1719 strcpy(varname, VAR_CURBUF);
1720 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1722 name = tclgetwindow(tclinfo.interp, curwin);
1723 strcpy(tclinfo.curwin, name);
1724 strcpy(varname, VAR_CURWIN);
1725 Tcl_UpdateLinkedVar(tclinfo.interp, varname);
1729 static int
1730 tclinit(eap)
1731 exarg_T *eap;
1733 char varname[VARNAME_SIZE]; /* Tcl_LinkVar requires writeable varname */
1734 char *name;
1736 #ifdef DYNAMIC_TCL
1737 if (!tcl_enabled(TRUE))
1739 EMSG(_("E571: Sorry, this command is disabled: the Tcl library could not be loaded."));
1740 return FAIL;
1742 #endif
1744 if (!tclinfo.interp)
1746 Tcl_Interp *interp;
1747 static Tcl_Channel ch1, ch2;
1749 /* replace stdout and stderr */
1750 ch1 = Tcl_CreateChannel(&channel_type, "vimout", VIMOUT, TCL_WRITABLE);
1751 ch2 = Tcl_CreateChannel(&channel_type, "vimerr", VIMERR, TCL_WRITABLE);
1752 Tcl_SetStdChannel(ch1, TCL_STDOUT);
1753 Tcl_SetStdChannel(ch2, TCL_STDERR);
1755 interp = Tcl_CreateInterp();
1756 Tcl_Preserve(interp);
1757 if (Tcl_Init(interp) == TCL_ERROR)
1759 Tcl_Release(interp);
1760 Tcl_DeleteInterp(interp);
1761 return FAIL;
1763 #if 0
1764 /* VIM sure is interactive */
1765 Tcl_SetVar(interp, "tcl_interactive", "1", TCL_GLOBAL_ONLY);
1766 #endif
1768 Tcl_SetChannelOption(interp, ch1, "-buffering", "line");
1769 Tcl_SetChannelOption(interp, ch2, "-buffering", "line");
1771 /* replace some standard Tcl commands */
1772 Tcl_DeleteCommand(interp, "exit");
1773 Tcl_CreateObjCommand(interp, "exit", exitcmd,
1774 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1775 Tcl_DeleteCommand(interp, "catch");
1776 Tcl_CreateObjCommand(interp, "catch", catchcmd,
1777 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1779 /* new commands, in ::vim namespace */
1780 Tcl_CreateObjCommand(interp, "::vim::buffer", buffercmd,
1781 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1782 Tcl_CreateObjCommand(interp, "::vim::window", windowcmd,
1783 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1784 Tcl_CreateObjCommand(interp, "::vim::command", commandcmd,
1785 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1786 Tcl_CreateObjCommand(interp, "::vim::beep", beepcmd,
1787 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1788 Tcl_CreateObjCommand(interp, "::vim::option", optioncmd,
1789 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1790 Tcl_CreateObjCommand(interp, "::vim::expr", exprcmd,
1791 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
1793 /* "lbase" variable */
1794 tclinfo.lbase = 1;
1795 strcpy(varname, VAR_LBASE);
1796 Tcl_LinkVar(interp, varname, (char *)&tclinfo.lbase, TCL_LINK_INT);
1798 /* "range" variable */
1799 tclinfo.range_start = eap->line1;
1800 strcpy(varname, VAR_RANGE1);
1801 Tcl_LinkVar(interp, varname, (char *)&tclinfo.range_start, TCL_LINK_INT|TCL_LINK_READ_ONLY);
1802 strcpy(varname, VAR_RANGE2);
1803 Tcl_LinkVar(interp, varname, (char *)&tclinfo.range_start, TCL_LINK_INT|TCL_LINK_READ_ONLY);
1804 tclinfo.range_end = eap->line2;
1805 strcpy(varname, VAR_RANGE3);
1806 Tcl_LinkVar(interp, varname, (char *)&tclinfo.range_end, TCL_LINK_INT|TCL_LINK_READ_ONLY);
1808 /* "current" variable */
1809 tclinfo.curbuf = Tcl_Alloc(VARNAME_SIZE);
1810 tclinfo.curwin = Tcl_Alloc(VARNAME_SIZE);
1811 name = tclgetbuffer(interp, curbuf);
1812 strcpy(tclinfo.curbuf, name);
1813 strcpy(varname, VAR_CURBUF);
1814 Tcl_LinkVar(interp, varname, (char *)&tclinfo.curbuf, TCL_LINK_STRING|TCL_LINK_READ_ONLY);
1815 name = tclgetwindow(interp, curwin);
1816 strcpy(tclinfo.curwin, name);
1817 strcpy(varname, VAR_CURWIN);
1818 Tcl_LinkVar(interp, varname, (char *)&tclinfo.curwin, TCL_LINK_STRING|TCL_LINK_READ_ONLY);
1820 tclinfo.interp = interp;
1822 else
1824 /* Interpreter already exists, just update variables */
1825 tclinfo.range_start = row2tcl(eap->line1);
1826 tclinfo.range_end = row2tcl(eap->line2);
1827 tclupdatevars();
1829 return OK;
1832 static void
1833 tclerrmsg(text)
1834 char *text;
1836 char *next;
1838 while ((next=strchr(text, '\n')))
1840 *next++ = '\0';
1841 EMSG(text);
1842 text = next;
1844 if (*text)
1845 EMSG(text);
1848 static void
1849 tclmsg(text)
1850 char *text;
1852 char *next;
1854 while ((next=strchr(text, '\n')))
1856 *next++ = '\0';
1857 MSG(text);
1858 text = next;
1860 if (*text)
1861 MSG(text);
1864 static void
1865 tcldelthisinterp()
1867 if (!Tcl_InterpDeleted(tclinfo.interp))
1868 Tcl_DeleteInterp(tclinfo.interp);
1869 Tcl_Release(tclinfo.interp);
1870 /* The interpreter is now gets deleted. All registered commands (esp.
1871 * window and buffer commands) are deleted, triggering their deletion
1872 * callback, which deletes all refs pointing to this interpreter.
1873 * We could garbage-collect the unused ref structs in all windows and
1874 * buffers, but unless the user creates hundreds of sub-interpreters
1875 * all referring to lots of windows and buffers, this is hardly worth
1876 * the effort. Unused refs are recycled by other interpreters, and
1877 * all refs are free'd when the window/buffer gets closed by vim.
1880 tclinfo.interp = NULL;
1881 Tcl_Free(tclinfo.curbuf);
1882 Tcl_Free(tclinfo.curwin);
1883 tclinfo.curbuf = tclinfo.curwin = NULL;
1886 static int
1887 tclexit(error)
1888 int error;
1890 int newerr = OK;
1892 if (error == TCL_EXIT )
1894 int retval;
1895 char buf[50];
1896 Tcl_Obj *robj;
1898 robj = Tcl_GetObjResult(tclinfo.interp);
1899 if( Tcl_GetIntFromObj(tclinfo.interp, robj, &retval) != TCL_OK )
1901 EMSG(_("E281: TCL ERROR: exit code is not int!? Please report this to vim-dev@vim.org"));
1902 newerr = FAIL;
1904 else
1906 sprintf(buf, _("E572: exit code %d"), retval);
1907 tclerrmsg(buf);
1908 if (retval == 0 )
1910 did_emsg = 0;
1911 newerr = OK;
1913 else
1914 newerr = FAIL;
1917 tcldelthisinterp();
1919 else
1921 char *result;
1923 result = (char *)Tcl_GetStringResult(tclinfo.interp);
1924 if (error == TCL_OK)
1926 tclmsg(result);
1927 newerr = OK;
1929 else
1931 tclerrmsg(result);
1932 newerr = FAIL;
1936 return newerr;
1940 * ":tcl"
1942 void
1943 ex_tcl(eap)
1944 exarg_T *eap;
1946 char_u *script;
1947 int err;
1949 script = script_get(eap, eap->arg);
1950 if (!eap->skip)
1952 err = tclinit(eap);
1953 if (err == OK)
1955 Tcl_AllowExceptions(tclinfo.interp);
1956 if (script == NULL)
1957 err = Tcl_Eval(tclinfo.interp, (char *)eap->arg);
1958 else
1959 err = Tcl_Eval(tclinfo.interp, (char *)script);
1960 err = tclexit(err);
1963 vim_free(script);
1967 * ":tclfile"
1969 void
1970 ex_tclfile(eap)
1971 exarg_T *eap;
1973 char *file = (char *)eap->arg;
1974 int err;
1976 err = tclinit(eap);
1977 if (err == OK)
1979 Tcl_AllowExceptions(tclinfo.interp);
1980 err = Tcl_EvalFile(tclinfo.interp, file);
1981 err = tclexit(err);
1986 * ":tcldo"
1988 void
1989 ex_tcldo(eap)
1990 exarg_T *eap;
1992 char *script, *line;
1993 int err, rs, re, lnum;
1994 char var_lnum[VARNAME_SIZE]; /* must be writeable memory */
1995 char var_line[VARNAME_SIZE];
1996 linenr_T first_line = 0;
1997 linenr_T last_line = 0;
1999 rs = eap->line1;
2000 re = eap->line2;
2001 script = (char *)eap->arg;
2002 strcpy(var_lnum, VAR_CURLNUM);
2003 strcpy(var_line, VAR_CURLINE);
2005 err = tclinit(eap);
2006 if (err != OK)
2007 return;
2009 lnum = row2tcl(rs);
2010 Tcl_LinkVar(tclinfo.interp, var_lnum, (char *)&lnum, TCL_LINK_INT|TCL_LINK_READ_ONLY);
2011 err = TCL_OK;
2012 if (u_save((linenr_T)(rs-1), (linenr_T)(re+1)) != OK)
2014 Tcl_SetResult(tclinfo.interp, _("cannot save undo information"), TCL_STATIC);
2015 err = TCL_ERROR;
2017 while (err == TCL_OK && rs <= re)
2019 line = (char *)ml_get_buf(curbuf, (linenr_T)rs, FALSE);
2020 if (!line)
2022 Tcl_SetResult(tclinfo.interp, _("cannot get line"), TCL_STATIC);
2023 err = TCL_ERROR;
2024 break;
2026 Tcl_SetVar(tclinfo.interp, var_line, line, 0);
2027 Tcl_AllowExceptions(tclinfo.interp);
2028 err = Tcl_Eval(tclinfo.interp, script);
2029 if (err != TCL_OK)
2030 break;
2031 line = (char *)Tcl_GetVar(tclinfo.interp, var_line, 0);
2032 if (line)
2034 if (ml_replace((linenr_T)rs, (char_u *)line, TRUE) != OK)
2036 Tcl_SetResult(tclinfo.interp, _("cannot replace line"), TCL_STATIC);
2037 err = TCL_ERROR;
2038 break;
2040 if (first_line == 0)
2041 first_line = rs;
2042 last_line = rs;
2044 ++rs;
2045 ++lnum;
2046 Tcl_UpdateLinkedVar(tclinfo.interp, var_lnum);
2048 if (first_line)
2049 changed_lines(first_line, 0, last_line + 1, (long)0);
2051 Tcl_UnsetVar(tclinfo.interp, var_line, 0);
2052 Tcl_UnlinkVar(tclinfo.interp, var_lnum);
2053 if (err == TCL_OK)
2054 Tcl_ResetResult(tclinfo.interp);
2056 (void)tclexit(err);
2059 static void
2060 tcldelallrefs(ref)
2061 struct ref *ref;
2063 struct ref *next;
2064 int err;
2065 char *result;
2067 while (ref != NULL)
2069 next = ref->next;
2070 if (ref->interp)
2072 if (ref->delcmd)
2074 err = Tcl_GlobalEvalObj(ref->interp, ref->delcmd);
2075 if (err != TCL_OK)
2077 result = (char *)Tcl_GetStringResult(ref->interp);
2078 if (result)
2079 tclerrmsg(result);
2081 Tcl_DecrRefCount(ref->delcmd);
2082 ref->delcmd = NULL;
2084 Tcl_DeleteCommandFromToken(ref->interp, ref->cmd);
2086 Tcl_Free((char *)ref);
2087 ref = next;
2091 void
2092 tcl_buffer_free(buf)
2093 buf_T *buf;
2095 struct ref *reflist;
2097 #ifdef DYNAMIC_TCL
2098 if (!stubs_initialized) /* Not using Tcl, nothing to do. */
2099 return;
2100 #endif
2102 reflist = (struct ref *)(buf->b_tcl_ref);
2103 if (reflist != &refsdeleted)
2105 buf->b_tcl_ref = (void *)&refsdeleted;
2106 tcldelallrefs(reflist);
2107 buf->b_tcl_ref = NULL;
2111 #if defined(FEAT_WINDOWS) || defined(PROTO)
2112 void
2113 tcl_window_free(win)
2114 win_T *win;
2116 struct ref *reflist;
2118 #ifdef DYNAMIC_TCL
2119 if (!stubs_initialized) /* Not using Tcl, nothing to do. */
2120 return;
2121 #endif
2123 reflist = (struct ref*)(win->w_tcl_ref);
2124 if (reflist != &refsdeleted)
2126 win->w_tcl_ref = (void *)&refsdeleted;
2127 tcldelallrefs(reflist);
2128 win->w_tcl_ref = NULL;
2131 #endif
2133 /* The End */