1 #pragma prototyped
2 /* Routines for commands:
3 *
4 * Tcl_CreateCommand, Tcl_DeleteCommand
5 * Tcl_Eval, Tcl_GlobalEval, Tcl_EvalFile, Tcl_VarEval, Tcl_RecordAndEval
6 * Tcl_CommandComplete
7 *
8 */
9
10 #include "tkshlib.h"
11 #include <nval.h>
12
13 static int inEval;
14
tksh_command(int argc,char * argv[],Shbltin_t * context)15 static int tksh_command(int argc, char *argv[], Shbltin_t *context)
16 {
17 int result, commandType, oldInterpType;
18 TkshCommandData *commandData = (TkshCommandData *)context->ptr;
19 Interp *interp = (Interp *) commandData->interp;
20
21 interp->shbltin = context;
22 Tcl_ResetResult(commandData->interp);
23
24 commandType = commandData->commandType;
25 commandData->commandType |= COMMAND_ACTIVE;
26 oldInterpType = interp->interpType;
27 /* oldListMode = TkshSetListMode(interp->interpType); */
28 if ((commandType&INTERP_MASK) != INTERP_CURRENT)
29 interp->interpType = commandType & INTERP_MASK;
30 result = commandData->info.proc(commandData->info.clientData,
31 commandData->interp, argc, argv);
32 interp->interpType = oldInterpType;
33 /* TkshSetListMode(oldListMode); */
34
35 if (interp->interpType != INTERP_TCL)
36 {
37 if (result == TCL_ERROR)
38 {
39 fprintf(stderr, "%s\n", commandData->interp->result);
40 sh.exitval = 1;
41 }
42 else
43 {
44 #if 0
45 if (commandData->interp->result &&
46 (*commandData->interp->result) &&
47 sfstdout->flags & SF_STRING)
48 #else
49 if (commandData->interp->result &&
50 (*commandData->interp->result) &&
51 (sfset(sfstdout, 0, 0) & SF_STRING || (
52 (!sh_getscope(1,1)) && !inEval &&
53 sh_isoption(SH_INTERACTIVE))))
54 #endif
55 {
56 sfprintf(sfstdout,"%s\n",
57 commandData->interp->result);
58 sfsync(sfstdout);
59 }
60 }
61 }
62 if (! (commandData->commandType & COMMAND_ACTIVE))
63 free (commandData); /* Command was deleted; free commandData */
64 else
65 commandData->commandType = commandType;
66 interp->cmdCount ++;
67 return result;
68 }
69
70 Tcl_Command
Tcl_CreateCommand(Tcl_Interp * interp,char * cmdName,Tcl_CmdProc * proc,ClientData clientData,Tcl_CmdDeleteProc * deleteProc)71 Tcl_CreateCommand (Tcl_Interp *interp, char *cmdName, Tcl_CmdProc *proc,
72 ClientData clientData, Tcl_CmdDeleteProc *deleteProc)
73 {
74 TkshCommandData *commandData;
75 Namval_t *nv;
76
77 if (((Interp *)interp)->flags & DELETED)
78 return (Tcl_Command) NULL;
79
80 if ((commandData = (TkshCommandData *)malloc(sizeof(TkshCommandData))))
81 {
82 commandData->info.clientData = clientData;
83 commandData->info.deleteData = clientData;
84 commandData->info.deleteProc = deleteProc;
85 commandData->info.proc = proc;
86 commandData->interp = interp;
87 #ifndef NO_TCL_EVAL
88 commandData->commandType = ((Interp *) interp)->interpType;
89 if ((cmdName[0]=='.') && (cmdName[1]==0))
90 cmdName = "tcl_dot"; /* General mapping coming soon */
91 dprintf(("Tksh: Added builtin: %s (%s)\n", cmdName,
92 Tksh_InterpString(commandData->commandType)));
93 #endif
94 sh_addbuiltin(cmdName, tksh_command, (void *) commandData);
95 }
96
97 nv = nv_search(cmdName, sh_bltin_tree(), 0);
98 nv->nvflag |= NV_NOFREE;
99 return (Tcl_Command) nv;
100 }
101
102 /*
103 *----------------------------------------------------------------------
104 *
105 * Tcl_GetCommandName --
106 *
107 * Given a token returned by Tcl_CreateCommand, this procedure
108 * returns the current name of the command (which may have changed
109 * due to renaming).
110 *
111 * Results:
112 * The return value is the name of the given command.
113 *
114 * Side effects:
115 * None.
116 *
117 *----------------------------------------------------------------------
118 */
119
120 char *
Tcl_GetCommandName(Tcl_Interp * interp,Tcl_Command command)121 Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command)
122 {
123 Namval_t *nv = (Namval_t *) command;
124 return nv_name(nv);
125 }
126
Tcl_DeleteCommand(Tcl_Interp * interp,char * cmdName)127 int Tcl_DeleteCommand (Tcl_Interp *interp, char *cmdName)
128 {
129 Namval_t *namval;
130 TkshCommandData *commandData;
131
132 if ((namval = nv_open(cmdName, sh.fun_tree, NV_NOADD)))
133 {
134 if (namval->nvalue == (void *) tksh_command)
135 {
136 commandData = (TkshCommandData *) namval->nvfun;
137 if (commandData && commandData->info.deleteProc)
138 {
139 commandData->info.deleteProc(
140 commandData->info.deleteData);
141 if (commandData->commandType & COMMAND_ACTIVE)
142 commandData->commandType &=(~COMMAND_ACTIVE);
143 else
144 free(commandData);
145 }
146 }
147 nv_close(namval);
148 sh_addbuiltin(cmdName, NULL, NULL); /* Removes */
149 namval->nvalue = NULL; /* XX ksh bug? */
150 return 0;
151 }
152 return -1;
153 }
154
155
Tcl_GetCommandInfo(Tcl_Interp * interp,char * cmdName,Tcl_CmdInfo * infoPtr)156 int Tcl_GetCommandInfo(Tcl_Interp *interp, char *cmdName,
157 Tcl_CmdInfo *infoPtr)
158 {
159 Namval_t *namval;
160 TkshCommandData *commandData = NULL;
161
162 if ((namval = nv_open(cmdName, sh.fun_tree, NV_NOADD)))
163 {
164 commandData = (TkshCommandData *) namval->nvfun;
165 if ((void *) namval->nvalue == (void *) tksh_command)
166 *infoPtr = commandData->info;
167 else
168 {
169 infoPtr->clientData = (ClientData) commandData;
170 infoPtr->proc = (Tcl_CmdProc *) namval->nvalue;
171 infoPtr->deleteData = (ClientData) namval->nvalue;
172 /* proc matching deleteData indicates ksh builtin */
173 }
174 nv_close(namval);
175 }
176 return (commandData ? 1 : 0);
177 }
178
179
Tcl_SetCommandInfo(Tcl_Interp * interp,char * cmdName,Tcl_CmdInfo * infoPtr)180 int Tcl_SetCommandInfo(Tcl_Interp *interp, char *cmdName, Tcl_CmdInfo *infoPtr)
181 {
182 Namval_t *namval;
183 TkshCommandData *commandData;
184
185 if ((namval = nv_open(cmdName, sh.fun_tree, NV_NOADD)))
186 {
187 commandData = (TkshCommandData *) namval->nvfun;
188 commandData->info = *infoPtr;
189 nv_close(namval);
190 return 1;
191 }
192 return 0;
193 }
194
Tksh_SetCommandType(Tcl_Interp * interp,char * cmdName,int tp)195 int Tksh_SetCommandType(Tcl_Interp *interp, char *cmdName, int tp)
196 {
197 Namval_t *namval;
198 TkshCommandData *commandData;
199
200 if ((namval = nv_open(cmdName, sh.fun_tree, NV_NOADD)))
201 {
202 commandData = (TkshCommandData *) namval->nvfun;
203 commandData->commandType &= (~INTERP_MASK);
204 commandData->commandType |= tp;
205 nv_close(namval);
206 return 1;
207 }
208 return 0;
209 }
210
fileToString(Sfio_t * f)211 static char *fileToString(Sfio_t *f)
212 {
213 /* return sfreserve(f,SF_UNBOUND,-1); */
214 char *out, *buf;
215 Sfio_t *strstm;
216 strstm = sfnew(NULL,NULL,-1,-1,SF_STRING|SF_READ|SF_WRITE);
217 sfmove(f,strstm,SF_UNBOUND,-1);
218 sfputc(strstm,0);
219 sfseek(strstm,0L,SEEK_SET);
220 buf = sfreserve(strstm,SF_UNBOUND,-1);
221 out = strdup(buf);
222 sfclose(strstm);
223 sfclrlock(f);
224 return out;
225 }
226
227
Tksh_Eval(Tcl_Interp * interp,char * command,int flag)228 int Tksh_Eval(Tcl_Interp *interp, char *command, int flag)
229 {
230 Sfio_t *f;
231 register Interp *iPtr = (Interp *) interp;
232 int result, oldInterpType = iPtr->interpType;
233
234 Tcl_FreeResult(interp);
235 interp->result = iPtr->resultSpace;
236 iPtr->resultSpace[0] = 0;
237
238 iPtr->interpType = INTERP_KSH;
239 dprintf2(("-- Tksh Eval --\n%s\n---------\n", flag?"--FILE--":command));
240
241 if (flag)
242 {
243 char *cmd;
244 f = sfopen(NIL(Sfio_t *),command, "r");
245 cmd = fileToString(f);
246 result = sh_trap(cmd, 0);
247 free(cmd);
248 sfclose(f);
249 }
250 else
251 {
252 result = sh_trap(command, 0);
253 }
254
255 iPtr->interpType = oldInterpType;
256 result = Tksh_MapReturn(result);
257
258 if (Tcl_AsyncReady())
259 result = Tcl_AsyncInvoke(interp, result);
260
261 if (iPtr->flags & DELETED)
262 Tcl_DeleteInterp(interp);
263
264 return result;
265 }
266
Tcl_Eval(Tcl_Interp * interp,char * cmd)267 int Tcl_Eval(Tcl_Interp *interp, char *cmd)
268 {
269 register Interp *iPtr = (Interp *) interp;
270 int result;
271 inEval ++;
272
273 /* The following takes care of instances where we invoke the
274 * Tcl parser instead of ksh's. As a bad hack, #!ksh or #!tcl
275 * can be specified in the script explicitly select a parser.
276 */
277
278 if (iPtr->interpType == INTERP_TCL)
279 {
280 if (strncmp(cmd, "#!ksh\n",6) != 0)
281 result = Tcl_TclEval(interp, cmd);
282 else
283 result = Tksh_Eval(interp, cmd+6, 0);
284 }
285 else /* oldInterp is INTERP_KSH */
286 {
287 if (strncmp(cmd, "#!tcl\n",6) == 0)
288 result = Tcl_TclEval(interp, cmd+6);
289 else
290 result = Tksh_Eval(interp, cmd, 0);
291 }
292 inEval --;
293 return result;
294 }
295
Tcl_TclEvalFile(Tcl_Interp * interp,char * fileName)296 int Tcl_TclEvalFile(Tcl_Interp *interp, char *fileName)
297 {
298 Interp *iPtr = (Interp *) interp;
299 Sfio_t *script;
300 char *cmdBuffer, *oldScriptFile;
301 int result, oldInterpType, oldListMode;
302
303 if (fileName)
304 {
305 oldScriptFile = iPtr->scriptFile;
306 iPtr->scriptFile = fileName;
307 script = sfopen(NIL(Sfio_t *), fileName, "r");
308 if (!script)
309 return TCL_ERROR;
310 }
311 else
312 {
313 fileName = "stdin";
314 script = sfstdin;
315 oldScriptFile = NIL(char*);
316 }
317
318 cmdBuffer = fileToString(script);
319 oldInterpType = iPtr->interpType;
320 oldListMode = TkshSetListMode(INTERP_TCL);
321 iPtr->interpType = INTERP_TCL;
322 result = Tcl_Eval(interp, cmdBuffer);
323 free(cmdBuffer);
324 iPtr->interpType = oldInterpType;
325 TkshSetListMode(oldListMode);
326 if (result == TCL_RETURN) {
327 result = TclUpdateReturnInfo((Interp *) interp);
328 } else if (result == TCL_ERROR) {
329 char msg[200];
330
331 /*
332 * Record information telling where the error occurred.
333 */
334
335 sprintf(msg, "\n (file \"%.150s\" line %d)", fileName,
336 interp->errorLine);
337 Tcl_AddErrorInfo(interp, msg);
338 }
339 if (oldScriptFile)
340 {
341 sfclose(script);
342 iPtr->scriptFile = oldScriptFile;
343 }
344 return result;
345 }
346
347
Tcl_EvalFile(Tcl_Interp * interp,char * fileName)348 int Tcl_EvalFile(Tcl_Interp *interp, char *fileName)
349 {
350 register Interp *iPtr = (Interp *) interp;
351 char *oldScriptFile;
352 int result;
353
354 #ifndef NO_TCL_EVAL
355 if (iPtr->interpType == INTERP_TCL)
356 return Tcl_TclEvalFile(interp, fileName);
357 #endif
358
359 #if 0 /* Do I need this or does ksh do the substitution? */
360 Tcl_DString buffer;
361 fileName = Tcl_TildeSubst(interp, fileName, &buffer);
362 if (fileName == NULL)
363 return TCL_ERROR;
364 #endif
365 oldScriptFile = iPtr->scriptFile;
366 iPtr->scriptFile = fileName;
367 dprintf(("EvalFile: %s\n", fileName));
368 result = Tksh_Eval(interp, fileName, 1);
369 iPtr->scriptFile = oldScriptFile;
370 return result;
371 }
372
373 #ifndef NEWKSH
Tcl_GlobalEval(Tcl_Interp * interp,char * cmd)374 int Tcl_GlobalEval(Tcl_Interp *interp, char *cmd)
375 {
376 int result, jmpval;
377 Hashtab_t *oldscope = sh.var_tree;
378
379 if (hashscope(sh.var_tree))
380 {
381 oldscope = sh.var_tree;
382 sh.var_tree = hashscope(sh.var_tree);
383 }
384
385 result = Tcl_Eval(interp, cmd);
386
387 sh.var_tree = oldscope;
388 return result;
389 }
390 #else
Tcl_GlobalEval(Tcl_Interp * interp,char * cmd)391 int Tcl_GlobalEval(Tcl_Interp *interp, char *cmd)
392 {
393 int result;
394 static Shscope_t *globalframe;
395 Shscope_t *oldframe;
396
397 /* if (!globalframe) */ /* XXX */
398 globalframe = sh_getscope(0, 0);
399 oldframe = sh_setscope(globalframe);
400 result = Tcl_Eval(interp, cmd);
401 sh_setscope(oldframe);
402 return result;
403 }
404
Tksh_GlobalEval(Tcl_Interp * interp,char * cmd,int interpType)405 int Tksh_GlobalEval(Tcl_Interp *interp, char *cmd, int interpType)
406 {
407 int result;
408 static Shscope_t *globalframe;
409 Shscope_t *oldframe;
410
411 if (!globalframe)
412 globalframe = sh_getscope(0, 0);
413 oldframe = sh_setscope(globalframe);
414 switch (interpType)
415 {
416 case INTERP_TCL: result = Tcl_TclEval(interp, cmd); break;
417 case INTERP_KSH: result = Tksh_Eval(interp, cmd,0); break;
418 default: result = Tcl_Eval(interp, cmd); break;
419 }
420 sh_setscope(oldframe);
421 return result;
422 }
423 #endif
424
425 /* Tcl_VarEval in tclvareval.c, but a faster way would be to use
426 sh_eval(sh_sfeval(args),0); */
427
Tcl_RecordAndEval(Tcl_Interp * interp,char * script,int flags)428 int Tcl_RecordAndEval(Tcl_Interp *interp, char *script, int flags)
429 {
430 int hist_state;
431 int result = TCL_OK;
432
433 if (flags == 0)
434 {
435 hist_state = sh_isoption(SH_HISTORY);
436 sh_onoption(SH_HISTORY);
437 result = Tcl_Eval(interp, script);
438 if (! hist_state)
439 sh_offoption(SH_HISTORY);
440 }
441 else /* TCL_NO_EVAL */
442 {
443 char *args[4];
444 args[0] = "print";
445 args[1] = "-s";
446 args[2] = script;
447 args[3] = 0;
448 b_print(3, args, (Shbltin_t *) NULL);
449 }
450
451 return result;
452 }
453
454 #ifdef NO_TCL_EVAL
455
456 /* This command just returns one because there is no point in using
457 * Tcl_CommandComplete unless you allow Tcl evaluation
458 */
459
Tcl_CommandComplete(char * cmd)460 int Tcl_CommandComplete(char *cmd)
461 {
462 return 1;
463 }
464
465 #endif
466