]>
Commit | Line | Data |
---|---|---|
c02a9557 JB |
1 | --- tcl8.5a4/unix/Makefile.in.orig 2006-04-26 17:43:12.000000000 +0200 |
2 | +++ tcl8.5a4/unix/Makefile.in 2006-05-24 00:56:49.007243250 +0200 | |
3 | @@ -289,7 +289,7 @@ | |
4 | DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ | |
5 | ${AC_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} @EXTRA_CC_SWITCHES@ | |
493f9747 | 6 | |
7 | -TCLSH_OBJS = tclAppInit.o | |
8 | +TCLSH_OBJS = tclAppInit.o rl-tclMain.o | |
9 | ||
10 | TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ | |
bd32470e | 11 | tclThreadTest.o tclUnixTest.o |
c02a9557 | 12 | @@ -574,7 +574,7 @@ |
493f9747 | 13 | |
14 | tclsh: ${TCLSH_OBJS} ${TCL_LIB_FILE} | |
c02a9557 | 15 | ${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \ |
bd32470e AF |
16 | - ${CC_SEARCH_FLAGS} -o tclsh |
17 | + -lreadline -lncurses ${CC_SEARCH_FLAGS} -o tclsh | |
493f9747 | 18 | |
bd32470e AF |
19 | # Resetting the LIB_RUNTIME_DIR below is required so that |
20 | # the generated tcltest executable gets the build directory | |
21 | --- /dev/null 1970-01-01 01:00:00.000000000 +0100 | |
22 | +++ tcl8.4.3/unix/rl-tclMain.c 2003-06-09 22:13:58.000000000 +0200 | |
493f9747 | 23 | @@ -0,0 +1,395 @@ |
24 | +/* | |
25 | + * tclMain.c -- | |
26 | + * | |
27 | + * Main program for Tcl shells and other Tcl-based applications. | |
28 | + * | |
29 | + * Copyright (c) 1988-1994 The Regents of the University of California. | |
30 | + * Copyright (c) 1994-1996 Sun Microsystems, Inc. | |
31 | + * | |
32 | + * See the file "license.terms" for information on usage and redistribution | |
33 | + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. | |
34 | + * | |
35 | + * SCCS: @(#) tclMain.c 1.54 97/08/07 19:04:43 | |
36 | + */ | |
37 | + | |
38 | +#include "tcl.h" | |
39 | +#include "tclInt.h" | |
40 | + | |
41 | +#ifndef USESTDIN | |
42 | +#ifndef __cplusplus | |
43 | +#include <readline/readline.h> | |
44 | +#else /* __cplusplus */ | |
45 | +EXTERN char *readline (char *prompt); | |
46 | +EXTERN void add_history (char *line); | |
47 | +#endif /* __cplusplus */ | |
48 | +#endif /* USESTDIN */ | |
49 | + | |
50 | +/* | |
51 | + * The following code ensures that tclLink.c is linked whenever | |
52 | + * Tcl is linked. Without this code there's no reference to the | |
53 | + * code in that file from anywhere in Tcl, so it may not be | |
54 | + * linked into the application. | |
55 | + */ | |
56 | + | |
57 | +EXTERN int tcl_LinkVar _ANSI_ARGS_((Tcl_Interp *interp, | |
58 | + char *varName, char *addr, int type)); | |
59 | +#ifdef __cplusplus | |
60 | +EXTERN | |
61 | +#endif /* __cplusplus */ | |
62 | +typedef int (*dummyfnptrtype)(Tcl_Interp *interp, char *varName, char *addr, int type); | |
63 | + | |
64 | +dummyfnptrtype tclDummyLinkVarPtr = Tcl_LinkVar; | |
65 | + | |
66 | +/* | |
67 | + * Declarations for various library procedures and variables (don't want | |
68 | + * to include tclPort.h here, because people might copy this file out of | |
69 | + * the Tcl source directory to make their own modified versions). | |
70 | + * Note: "exit" should really be declared here, but there's no way to | |
71 | + * declare it without causing conflicts with other definitions elsewher | |
72 | + * on some systems, so it's better just to leave it out. | |
73 | + */ | |
74 | + | |
75 | +EXTERN int isatty _ANSI_ARGS_((int fd)); | |
76 | +EXTERN char * strcpy _ANSI_ARGS_((char *dst, CONST char *src)); | |
77 | + | |
78 | +static Tcl_Interp *interp; /* Interpreter for application. */ | |
79 | + | |
80 | +#ifdef TCL_MEM_DEBUG | |
81 | +static char dumpFile[100]; /* Records where to dump memory allocation | |
82 | + * information. */ | |
83 | +static int quitFlag = 0; /* 1 means "checkmem" command was called, | |
84 | + * so the application should quit and dump | |
85 | + * memory allocation information. */ | |
86 | +#endif | |
87 | + | |
88 | +/* | |
89 | + * Forward references for procedures defined later in this file: | |
90 | + */ | |
91 | + | |
92 | +#ifdef TCL_MEM_DEBUG | |
93 | +static int CheckmemCmd _ANSI_ARGS_((ClientData clientData, | |
94 | + Tcl_Interp *interp, int argc, char *argv[])); | |
95 | +#endif | |
96 | +\f | |
97 | +/* | |
98 | + *---------------------------------------------------------------------- | |
99 | + * | |
100 | + * Tcl_Main -- | |
101 | + * | |
102 | + * Main program for tclsh and most other Tcl-based applications. | |
103 | + * | |
104 | + * Results: | |
105 | + * None. This procedure never returns (it exits the process when | |
106 | + * it's done. | |
107 | + * | |
108 | + * Side effects: | |
109 | + * This procedure initializes the Tk world and then starts | |
110 | + * interpreting commands; almost anything could happen, depending | |
111 | + * on the script being interpreted. | |
112 | + * | |
113 | + *---------------------------------------------------------------------- | |
114 | + */ | |
115 | + | |
116 | +void | |
117 | +Tcl_Main( | |
118 | + int argc, /* Number of arguments. */ | |
119 | + char **argv, /* Array of argument strings. */ | |
120 | + Tcl_AppInitProc *appInitProc) | |
121 | + /* Application-specific initialization | |
122 | + * procedure to call after most | |
123 | + * initialization but before starting to | |
124 | + * execute commands. */ | |
125 | +{ | |
126 | + Tcl_Obj *prompt1NamePtr = NULL; | |
127 | + Tcl_Obj *prompt2NamePtr = NULL; | |
128 | + Tcl_Obj *resultPtr; | |
129 | + Tcl_Obj *commandPtr = NULL; | |
130 | + char buffer[1000], *args, *fileName, *bytes; | |
131 | + int code, gotPartial, tty, length; | |
132 | + int exitCode = 0; | |
133 | + Tcl_Channel inChannel, outChannel, errChannel; | |
134 | + | |
135 | + Tcl_FindExecutable(argv[0]); | |
136 | + interp = Tcl_CreateInterp(); | |
137 | +#ifdef TCL_MEM_DEBUG | |
138 | + Tcl_InitMemory(interp); | |
139 | + Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, | |
140 | + (Tcl_CmdDeleteProc *) NULL); | |
141 | +#endif | |
142 | + | |
143 | + /* | |
144 | + * Make command-line arguments available in the Tcl variables "argc" | |
145 | + * and "argv". If the first argument doesn't start with a "-" then | |
146 | + * strip it off and use it as the name of a script file to process. | |
147 | + */ | |
148 | + | |
149 | + fileName = NULL; | |
150 | + if ((argc > 1) && (argv[1][0] != '-')) { | |
151 | + fileName = argv[1]; | |
152 | + argc--; | |
153 | + argv++; | |
154 | + } | |
155 | + args = Tcl_Merge(argc-1, argv+1); | |
156 | + Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY); | |
157 | + ckfree(args); | |
158 | + TclFormatInt(buffer, argc-1); | |
159 | + Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY); | |
160 | + Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0], | |
161 | + TCL_GLOBAL_ONLY); | |
162 | + | |
163 | + /* | |
164 | + * Set the "tcl_interactive" variable. | |
165 | + */ | |
166 | + | |
167 | + tty = isatty(0); | |
168 | + Tcl_SetVar(interp, "tcl_interactive", | |
169 | + ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY); | |
170 | + | |
171 | + /* | |
172 | + * Invoke application-specific initialization. | |
173 | + */ | |
174 | + | |
175 | + if ((*appInitProc)(interp) != TCL_OK) { | |
176 | + errChannel = Tcl_GetStdChannel(TCL_STDERR); | |
177 | + if (errChannel) { | |
178 | + Tcl_Write(errChannel, | |
179 | + "application-specific initialization failed: ", -1); | |
180 | + Tcl_Write(errChannel, interp->result, -1); | |
181 | + Tcl_Write(errChannel, "\n", 1); | |
182 | + } | |
183 | + } | |
184 | + | |
185 | + /* | |
186 | + * If a script file was specified then just source that file | |
187 | + * and quit. | |
188 | + */ | |
189 | + | |
190 | + if (fileName != NULL) { | |
191 | + code = Tcl_EvalFile(interp, fileName); | |
192 | + if (code != TCL_OK) { | |
193 | + errChannel = Tcl_GetStdChannel(TCL_STDERR); | |
194 | + if (errChannel) { | |
195 | + /* | |
196 | + * The following statement guarantees that the errorInfo | |
197 | + * variable is set properly. | |
198 | + */ | |
199 | + | |
200 | + Tcl_AddErrorInfo(interp, ""); | |
201 | + Tcl_Write(errChannel, | |
202 | + Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1); | |
203 | + Tcl_Write(errChannel, "\n", 1); | |
204 | + } | |
205 | + exitCode = 1; | |
206 | + } | |
207 | + goto done; | |
208 | + } | |
209 | + | |
210 | + /* | |
211 | + * We're running interactively. Source a user-specific startup | |
212 | + * file if the application specified one and if the file exists. | |
213 | + */ | |
214 | + | |
215 | + Tcl_SourceRCFile(interp); | |
216 | + | |
217 | + /* | |
218 | + * Process commands from stdin until there's an end-of-file. Note | |
219 | + * that we need to fetch the standard channels again after every | |
220 | + * eval, since they may have been changed. | |
221 | + */ | |
222 | + | |
223 | + commandPtr = Tcl_NewObj(); | |
224 | + Tcl_IncrRefCount(commandPtr); | |
225 | + prompt1NamePtr = Tcl_NewStringObj("tcl_prompt1", -1); | |
226 | + Tcl_IncrRefCount(prompt1NamePtr); | |
227 | + prompt2NamePtr = Tcl_NewStringObj("tcl_prompt2", -1); | |
228 | + Tcl_IncrRefCount(prompt2NamePtr); | |
229 | + | |
230 | + inChannel = Tcl_GetStdChannel(TCL_STDIN); | |
231 | + outChannel = Tcl_GetStdChannel(TCL_STDOUT); | |
232 | + gotPartial = 0; | |
233 | + while (1) { | |
234 | + if (tty) { | |
235 | + Tcl_Obj *promptCmdPtr; | |
236 | + char *prompt; | |
237 | + char *line; | |
238 | + | |
239 | + promptCmdPtr = Tcl_ObjGetVar2(interp, | |
240 | + (gotPartial? prompt2NamePtr : prompt1NamePtr), | |
241 | + (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY); | |
242 | + if (promptCmdPtr == NULL) { | |
243 | + defaultPrompt: | |
244 | + if (!gotPartial) { | |
245 | + prompt = "% "; | |
246 | + } else { | |
247 | + prompt = "+ "; | |
248 | + } | |
249 | + length = strlen(prompt); | |
250 | + } else { | |
251 | + code = Tcl_EvalObj(interp, promptCmdPtr); | |
252 | + inChannel = Tcl_GetStdChannel(TCL_STDIN); | |
253 | + outChannel = Tcl_GetStdChannel(TCL_STDOUT); | |
254 | + errChannel = Tcl_GetStdChannel(TCL_STDERR); | |
255 | + if (code != TCL_OK) { | |
256 | + if (errChannel) { | |
257 | + resultPtr = Tcl_GetObjResult(interp); | |
258 | + bytes = Tcl_GetStringFromObj(resultPtr, &length); | |
259 | + Tcl_Write(errChannel, bytes, length); | |
260 | + Tcl_Write(errChannel, "\n", 1); | |
261 | + } | |
262 | + Tcl_AddErrorInfo(interp, | |
263 | + "\n (script that generates prompt)"); | |
264 | + goto defaultPrompt; | |
265 | + } | |
266 | + resultPtr = Tcl_GetObjResult(interp); | |
267 | + prompt = Tcl_GetStringFromObj(resultPtr, &length); | |
268 | + } | |
269 | +#ifdef USESTDIN | |
270 | + if (outChannel) { | |
271 | + Tcl_Write(outChannel, prompt, length); | |
272 | + Tcl_Flush(outChannel); | |
273 | + } | |
274 | + } | |
275 | + if (!inChannel) { | |
276 | + goto done; | |
277 | + } | |
278 | + length = Tcl_GetsObj(inChannel, commandPtr); | |
279 | + if (length < 0) { | |
280 | + goto done; | |
281 | + } | |
282 | + if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) { | |
283 | + goto done; | |
284 | + } | |
285 | + | |
286 | +#else /* !USESTDIN */ | |
287 | + line = readline(prompt); | |
288 | + if(line != NULL) { | |
289 | + length = strlen(line); | |
290 | + Tcl_AppendToObj(commandPtr, line, length); | |
291 | + } else { | |
292 | + goto done; | |
293 | + } | |
294 | + /* Clean up the string allocated by readline & add it to history */ | |
295 | + if(line) { | |
296 | + if(*line) { | |
297 | + add_history(line); | |
298 | + } | |
299 | + free(line); | |
300 | + } | |
301 | + } else { | |
302 | + /* using readline but not a tty - must use gets */ | |
303 | + if (!inChannel) { | |
304 | + goto done; | |
305 | + } | |
306 | + length = Tcl_GetsObj(inChannel, commandPtr); | |
307 | + if (length < 0) { | |
308 | + goto done; | |
309 | + } | |
310 | + if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) { | |
311 | + goto done; | |
312 | + } | |
313 | + } | |
314 | + | |
315 | +#endif /* USESTDIN */ | |
316 | + | |
317 | + /* | |
318 | + * Add the newline removed by Tcl_GetsObj back to the string. | |
319 | + */ | |
320 | + | |
321 | + Tcl_AppendToObj(commandPtr, "\n", 1); | |
322 | + if (!TclObjCommandComplete(commandPtr)) { | |
323 | + gotPartial = 1; | |
324 | + continue; | |
325 | + } | |
326 | + | |
327 | + gotPartial = 0; | |
328 | + code = Tcl_RecordAndEvalObj(interp, commandPtr, 0); | |
329 | + inChannel = Tcl_GetStdChannel(TCL_STDIN); | |
330 | + outChannel = Tcl_GetStdChannel(TCL_STDOUT); | |
331 | + errChannel = Tcl_GetStdChannel(TCL_STDERR); | |
332 | + Tcl_SetObjLength(commandPtr, 0); | |
333 | + if (code != TCL_OK) { | |
334 | + if (errChannel) { | |
335 | + resultPtr = Tcl_GetObjResult(interp); | |
336 | + bytes = Tcl_GetStringFromObj(resultPtr, &length); | |
337 | + Tcl_Write(errChannel, bytes, length); | |
338 | + Tcl_Write(errChannel, "\n", 1); | |
339 | + } | |
340 | + } else if (tty) { | |
341 | + resultPtr = Tcl_GetObjResult(interp); | |
342 | + bytes = Tcl_GetStringFromObj(resultPtr, &length); | |
343 | + if ((length > 0) && outChannel) { | |
344 | + Tcl_Write(outChannel, bytes, length); | |
345 | + Tcl_Write(outChannel, "\n", 1); | |
346 | + } | |
347 | + } | |
348 | +#ifdef TCL_MEM_DEBUG | |
349 | + if (quitFlag) { | |
350 | + Tcl_DecrRefCount(commandPtr); | |
351 | + Tcl_DecrRefCount(prompt1NamePtr); | |
352 | + Tcl_DecrRefCount(prompt2NamePtr); | |
353 | + Tcl_DeleteInterp(interp); | |
354 | + Tcl_Exit(0); | |
355 | + } | |
356 | +#endif | |
357 | + } | |
358 | + | |
359 | + /* | |
360 | + * Rather than calling exit, invoke the "exit" command so that | |
361 | + * users can replace "exit" with some other command to do additional | |
362 | + * cleanup on exit. The Tcl_Eval call should never return. | |
363 | + */ | |
364 | + | |
365 | + done: | |
366 | + if (commandPtr != NULL) { | |
367 | + Tcl_DecrRefCount(commandPtr); | |
368 | + } | |
369 | + if (prompt1NamePtr != NULL) { | |
370 | + Tcl_DecrRefCount(prompt1NamePtr); | |
371 | + } | |
372 | + if (prompt2NamePtr != NULL) { | |
373 | + Tcl_DecrRefCount(prompt2NamePtr); | |
374 | + } | |
375 | + sprintf(buffer, "exit %d", exitCode); | |
376 | + Tcl_Eval(interp, buffer); | |
377 | +} | |
378 | +\f | |
379 | +/* | |
380 | + *---------------------------------------------------------------------- | |
381 | + * | |
382 | + * CheckmemCmd -- | |
383 | + * | |
384 | + * This is the command procedure for the "checkmem" command, which | |
385 | + * causes the application to exit after printing information about | |
386 | + * memory usage to the file passed to this command as its first | |
387 | + * argument. | |
388 | + * | |
389 | + * Results: | |
390 | + * Returns a standard Tcl completion code. | |
391 | + * | |
392 | + * Side effects: | |
393 | + * None. | |
394 | + * | |
395 | + *---------------------------------------------------------------------- | |
396 | + */ | |
397 | +#ifdef TCL_MEM_DEBUG | |
398 | + | |
399 | + /* ARGSUSED */ | |
400 | +static int | |
401 | +CheckmemCmd( | |
402 | + ClientData clientData, /* Not used. */ | |
403 | + Tcl_Interp *interp, /* Interpreter for evaluation. */ | |
404 | + int argc, /* Number of arguments. */ | |
405 | + char *argv[]) /* String values of arguments. */ | |
406 | +{ | |
407 | + extern char *tclMemDumpFileName; | |
408 | + if (argc != 2) { | |
409 | + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], | |
410 | + " fileName\"", (char *) NULL); | |
411 | + return TCL_ERROR; | |
412 | + } | |
413 | + strcpy(dumpFile, argv[1]); | |
414 | + tclMemDumpFileName = dumpFile; | |
415 | + quitFlag = 1; | |
416 | + return TCL_OK; | |
417 | +} | |
418 | +#endif |