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