1/*
2 * tkMain.c --
3 *
4 *	This file contains a generic main program for Tk-based applications.
5 *	It can be used as-is for many applications, just by supplying a
6 *	different appInitProc function for each specific application. Or, it
7 *	can be used as a template for creating new main programs for Tk
8 *	applications.
9 *
10 * Copyright (c) 1990-1994 The Regents of the University of California.
11 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
12 *
13 * See the file "license.terms" for information on usage and redistribution of
14 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 *
16 * RCS: @(#) $Id$
17 */
18
19#include "tclInt.h"
20#include "tkInt.h"
21#ifdef __WIN32__
22#include "tkWinInt.h"
23#endif
24#ifdef MAC_OSX_TK
25#include "tkMacOSXInt.h"
26#endif
27
28
29typedef struct ThreadSpecificData {
30    Tcl_Interp *interp;		/* Interpreter for this thread. */
31    Tcl_DString command;	/* Used to assemble lines of terminal input
32				 * into Tcl commands. */
33    Tcl_DString line;		/* Used to read the next line from the
34				 * terminal input. */
35    int tty;			/* Non-zero means standard input is a
36				 * terminal-like device. Zero means it's a
37				 * file. */
38} ThreadSpecificData;
39static Tcl_ThreadDataKey dataKey;
40
41/*
42 * Declarations for various library functions and variables (don't want to
43 * include tkInt.h or tkPort.h here, because people might copy this file out
44 * of the Tk source directory to make their own modified versions). Note: do
45 * not declare "exit" here even though a declaration is really needed, because
46 * it will conflict with a declaration elsewhere on some systems.
47 */
48
49#if !defined(__WIN32__) && !defined(_WIN32)
50extern int		isatty(int fd);
51extern char *		strrchr(CONST char *string, int c);
52#endif
53
54/*
55 * Forward declarations for functions defined later in this file.
56 */
57
58static void		Prompt(Tcl_Interp *interp, int partial);
59static void		StdinProc(ClientData clientData, int mask);
60
61/*
62 *----------------------------------------------------------------------
63 *
64 * Tk_MainEx --
65 *
66 *	Main program for Wish and most other Tk-based applications.
67 *
68 * Results:
69 *	None. This function never returns (it exits the process when it's
70 *	done.
71 *
72 * Side effects:
73 *	This function initializes the Tk world and then starts interpreting
74 *	commands; almost anything could happen, depending on the script being
75 *	interpreted.
76 *
77 *----------------------------------------------------------------------
78 */
79
80void
81Tk_MainEx(
82    int argc,			/* Number of arguments. */
83    char **argv,		/* Array of argument strings. */
84    Tcl_AppInitProc *appInitProc,
85				/* Application-specific initialization
86				 * function to call after most initialization
87				 * but before starting to execute commands. */
88    Tcl_Interp *interp)
89{
90    Tcl_Obj *path, *argvPtr;
91    CONST char *encodingName;
92    int code, nullStdin = 0;
93    Tcl_Channel inChannel, outChannel;
94    ThreadSpecificData *tsdPtr;
95#ifdef __WIN32__
96    HANDLE handle;
97#endif
98    Tcl_DString appName;
99
100    /*
101     * Ensure that we are getting the matching version of Tcl. This is really
102     * only an issue when Tk is loaded dynamically.
103     */
104
105    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
106	abort();
107    }
108
109    tsdPtr = (ThreadSpecificData *)
110	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
111
112    Tcl_FindExecutable(argv[0]);
113    tsdPtr->interp = interp;
114    Tcl_Preserve((ClientData) interp);
115
116#if defined(__WIN32__)
117    Tk_InitConsoleChannels(interp);
118#endif
119
120#ifdef MAC_OSX_TK
121    if (Tcl_GetStartupScript(NULL) == NULL) {
122	TkMacOSXDefaultStartupScript();
123    }
124#endif
125
126#ifdef TCL_MEM_DEBUG
127    Tcl_InitMemory(interp);
128#endif
129
130    /*
131     * If the application has not already set a startup script, parse the
132     * first few command line arguments to determine the script path and
133     * encoding.
134     */
135
136    if (NULL == Tcl_GetStartupScript(NULL)) {
137	size_t length;
138
139	/*
140	 * Check whether first 3 args (argv[1] - argv[3]) look like
141	 * 	-encoding ENCODING FILENAME
142	 * or like
143	 * 	FILENAME
144	 * or like
145	 *	-file FILENAME		(ancient history support only)
146	 */
147
148	if ((argc > 3) && (0 == strcmp("-encoding", argv[1]))
149		&& ('-' != argv[3][0])) {
150	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]);
151	    argc -= 3;
152	    argv += 3;
153	} else if ((argc > 1) && ('-' != argv[1][0])) {
154	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL);
155	    argc--;
156	    argv++;
157	} else if ((argc > 2) && (length = strlen(argv[1]))
158		&& (length > 1) && (0 == strncmp("-file", argv[1], length))
159		&& ('-' != argv[2][0])) {
160	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[2], -1), NULL);
161	    argc -= 2;
162	    argv += 2;
163	}
164    }
165
166    path = Tcl_GetStartupScript(&encodingName);
167    if (NULL == path) {
168	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
169    } else {
170	int numBytes;
171	CONST char *pathName = Tcl_GetStringFromObj(path, &numBytes);
172
173	Tcl_ExternalToUtfDString(NULL, pathName, numBytes, &appName);
174	path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
175	Tcl_SetStartupScript(path, encodingName);
176    }
177    Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
178    Tcl_DStringFree(&appName);
179    argc--;
180    argv++;
181
182    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
183
184    argvPtr = Tcl_NewListObj(0, NULL);
185    while (argc--) {
186	Tcl_DString ds;
187
188	Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
189	Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
190		Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
191	Tcl_DStringFree(&ds);
192    }
193    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
194
195    /*
196     * Set the "tcl_interactive" variable.
197     */
198
199#ifdef __WIN32__
200    /*
201     * For now, under Windows, we assume we are not running as a console mode
202     * app, so we need to use the GUI console. In order to enable this, we
203     * always claim to be running on a tty. This probably isn't the right way
204     * to do it.
205     */
206
207    handle = GetStdHandle(STD_INPUT_HANDLE);
208
209    if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)
210	     || (GetFileType(handle) == FILE_TYPE_UNKNOWN)) {
211	/*
212	 * If it's a bad or closed handle, then it's been connected to a wish
213	 * console window.
214	 */
215
216	tsdPtr->tty = 1;
217    } else if (GetFileType(handle) == FILE_TYPE_CHAR) {
218	/*
219	 * A character file handle is a tty by definition.
220	 */
221
222	tsdPtr->tty = 1;
223    } else {
224	tsdPtr->tty = 0;
225    }
226
227#else
228    tsdPtr->tty = isatty(0);
229#endif
230#if defined(MAC_OSX_TK)
231    /*
232     * On TkAqua, if we don't have a TTY and stdin is a special character file
233     * of length 0, (e.g. /dev/null, which is what Finder sets when double
234     * clicking Wish) then use the GUI console.
235     */
236
237    if (!tsdPtr->tty) {
238	struct stat st;
239
240	nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks);
241    }
242#endif
243    Tcl_SetVar(interp, "tcl_interactive",
244	    ((path == NULL) && (tsdPtr->tty || nullStdin)) ? "1" : "0",
245	    TCL_GLOBAL_ONLY);
246
247    /*
248     * Invoke application-specific initialization.
249     */
250
251    if ((*appInitProc)(interp) != TCL_OK) {
252	TkpDisplayWarning(Tcl_GetStringResult(interp),
253		"Application initialization failed");
254    }
255
256    /*
257     * Invoke the script specified on the command line, if any. Must fetch it
258     * again, as the appInitProc might have reset it.
259     */
260
261    path = Tcl_GetStartupScript(&encodingName);
262    if (path != NULL) {
263	Tcl_ResetResult(interp);
264	code = Tcl_FSEvalFileEx(interp, path, encodingName);
265	if (code != TCL_OK) {
266	    /*
267	     * The following statement guarantees that the errorInfo variable
268	     * is set properly.
269	     */
270
271	    Tcl_AddErrorInfo(interp, "");
272	    TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
273		    TCL_GLOBAL_ONLY), "Error in startup script");
274	    Tcl_DeleteInterp(interp);
275	    Tcl_Exit(1);
276	}
277	tsdPtr->tty = 0;
278    } else {
279
280	/*
281	 * Evaluate the .rc file, if one has been specified.
282	 */
283
284	Tcl_SourceRCFile(interp);
285
286	/*
287	 * Establish a channel handler for stdin.
288	 */
289
290	inChannel = Tcl_GetStdChannel(TCL_STDIN);
291	if (inChannel) {
292	    Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
293		    (ClientData) inChannel);
294	}
295	if (tsdPtr->tty) {
296	    Prompt(interp, 0);
297	}
298    }
299
300    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
301    if (outChannel) {
302	Tcl_Flush(outChannel);
303    }
304    Tcl_DStringInit(&tsdPtr->command);
305    Tcl_DStringInit(&tsdPtr->line);
306    Tcl_ResetResult(interp);
307
308    /*
309     * Loop infinitely, waiting for commands to execute. When there are no
310     * windows left, Tk_MainLoop returns and we exit.
311     */
312
313    Tk_MainLoop();
314    Tcl_DeleteInterp(interp);
315    Tcl_Release((ClientData) interp);
316    Tcl_SetStartupScript(NULL, NULL);
317    Tcl_Exit(0);
318}
319
320/*
321 *----------------------------------------------------------------------
322 *
323 * StdinProc --
324 *
325 *	This function is invoked by the event dispatcher whenever standard
326 *	input becomes readable. It grabs the next line of input characters,
327 *	adds them to a command being assembled, and executes the command if
328 *	it's complete.
329 *
330 * Results:
331 *	None.
332 *
333 * Side effects:
334 *	Could be almost arbitrary, depending on the command that's typed.
335 *
336 *----------------------------------------------------------------------
337 */
338
339    /* ARGSUSED */
340static void
341StdinProc(
342    ClientData clientData,	/* Not used. */
343    int mask)			/* Not used. */
344{
345    static int gotPartial = 0;
346    char *cmd;
347    int code, count;
348    Tcl_Channel chan = (Tcl_Channel) clientData;
349    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
350	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
351    Tcl_Interp *interp = tsdPtr->interp;
352
353    count = Tcl_Gets(chan, &tsdPtr->line);
354
355    if (count < 0 && !gotPartial) {
356	if (tsdPtr->tty) {
357	    Tcl_Exit(0);
358	} else {
359	    Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
360	}
361	return;
362    }
363
364    (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
365	    &tsdPtr->line), -1);
366    cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
367    Tcl_DStringFree(&tsdPtr->line);
368    if (!Tcl_CommandComplete(cmd)) {
369	gotPartial = 1;
370	goto prompt;
371    }
372    gotPartial = 0;
373
374    /*
375     * Disable the stdin channel handler while evaluating the command;
376     * otherwise if the command re-enters the event loop we might process
377     * commands from stdin before the current command is finished. Among other
378     * things, this will trash the text of the command being evaluated.
379     */
380
381    Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
382    code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
383
384    chan = Tcl_GetStdChannel(TCL_STDIN);
385    if (chan) {
386	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
387		(ClientData) chan);
388    }
389    Tcl_DStringFree(&tsdPtr->command);
390    if (Tcl_GetStringResult(interp)[0] != '\0') {
391	if ((code != TCL_OK) || (tsdPtr->tty)) {
392	    chan = Tcl_GetStdChannel(TCL_STDOUT);
393	    if (chan) {
394		Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
395		Tcl_WriteChars(chan, "\n", 1);
396	    }
397	}
398    }
399
400    /*
401     * Output a prompt.
402     */
403
404  prompt:
405    if (tsdPtr->tty) {
406	Prompt(interp, gotPartial);
407    }
408    Tcl_ResetResult(interp);
409}
410
411/*
412 *----------------------------------------------------------------------
413 *
414 * Prompt --
415 *
416 *	Issue a prompt on standard output, or invoke a script to issue the
417 *	prompt.
418 *
419 * Results:
420 *	None.
421 *
422 * Side effects:
423 *	A prompt gets output, and a Tcl script may be evaluated in interp.
424 *
425 *----------------------------------------------------------------------
426 */
427
428static void
429Prompt(
430    Tcl_Interp *interp,		/* Interpreter to use for prompting. */
431    int partial)		/* Non-zero means there already exists a
432				 * partial command, so use the secondary
433				 * prompt. */
434{
435    Tcl_Obj *promptCmd;
436    int code;
437    Tcl_Channel outChannel, errChannel;
438
439    promptCmd = Tcl_GetVar2Ex(interp,
440	partial ? "tcl_prompt2" : "tcl_prompt1", NULL, TCL_GLOBAL_ONLY);
441    if (promptCmd == NULL) {
442    defaultPrompt:
443	if (!partial) {
444	    /*
445	     * We must check that outChannel is a real channel - it is
446	     * possible that someone has transferred stdout out of this
447	     * interpreter with "interp transfer".
448	     */
449
450	    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
451	    if (outChannel != (Tcl_Channel) NULL) {
452		Tcl_WriteChars(outChannel, "% ", 2);
453	    }
454	}
455    } else {
456	code = Tcl_EvalObjEx(interp, promptCmd, TCL_EVAL_GLOBAL);
457	if (code != TCL_OK) {
458	    Tcl_AddErrorInfo(interp,
459		    "\n    (script that generates prompt)");
460
461	    /*
462	     * We must check that errChannel is a real channel - it is
463	     * possible that someone has transferred stderr out of this
464	     * interpreter with "interp transfer".
465	     */
466
467	    errChannel = Tcl_GetChannel(interp, "stderr", NULL);
468	    if (errChannel != (Tcl_Channel) NULL) {
469		Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
470		Tcl_WriteChars(errChannel, "\n", 1);
471	    }
472	    goto defaultPrompt;
473	}
474    }
475    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
476    if (outChannel != (Tcl_Channel) NULL) {
477	Tcl_Flush(outChannel);
478    }
479}
480
481/*
482 * Local Variables:
483 * mode: c
484 * c-basic-offset: 4
485 * fill-column: 78
486 * End:
487 */
488