/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkmain.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkmain.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69 - (show annotations) (download)
Sat Nov 5 10:54:17 2016 UTC (6 years, 3 months ago) by dashley
File MIME type: text/plain
File size: 15240 byte(s)
License and property (keyword) changes.
1 /* $Header$ */
2
3 /*
4 * tkMain.c --
5 *
6 * This file contains a generic main program for Tk-based applications.
7 * It can be used as-is for many applications, just by supplying a
8 * different appInitProc procedure for each specific application.
9 * Or, it can be used as a template for creating new main programs
10 * for Tk applications.
11 *
12 * Copyright (c) 1990-1994 The Regents of the University of California.
13 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
14 *
15 * See the file "license.terms" for information on usage and redistribution
16 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
17 *
18 * RCS: @(#) $Id: tkmain.c,v 1.1.1.1 2001/06/13 05:05:07 dtashley Exp $
19 */
20
21 #define MODULE_TK_MAIN
22
23 #include <ctype.h>
24 #include <stdio.h>
25 #include <string.h>
26 #include <tcl.h>
27 #include <tclInt.h>
28
29 #include "appinit.h"
30 #include "build_config.h"
31 #include "extninit.h"
32 #include "msgstrs.h"
33
34 #include "tk.h"
35 #include "tkInt.h"
36 #ifdef NO_STDLIB_H
37 # include "../compat/stdlib.h"
38 #else
39 # include <stdlib.h>
40 #endif
41 #ifdef __WIN32__
42 #include "tkWinInt.h"
43 #endif
44
45
46 typedef struct ThreadSpecificData {
47 Tcl_Interp *interp; /* Interpreter for this thread. */
48 Tcl_DString command; /* Used to assemble lines of terminal input
49 * into Tcl commands. */
50 Tcl_DString line; /* Used to read the next line from the
51 * terminal input. */
52 int tty; /* Non-zero means standard input is a
53 * terminal-like device. Zero means it's
54 * a file. */
55 } ThreadSpecificData;
56 Tcl_ThreadDataKey dataKey;
57
58 /*
59 * Declarations for various library procedures and variables (don't want
60 * to include tkInt.h or tkPort.h here, because people might copy this
61 * file out of the Tk source directory to make their own modified versions).
62 * Note: don't declare "exit" here even though a declaration is really
63 * needed, because it will conflict with a declaration elsewhere on
64 * some systems.
65 */
66
67 #if !defined(__WIN32__) && !defined(_WIN32)
68 extern int isatty _ANSI_ARGS_((int fd));
69 extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
70 #endif
71 extern void TkpDisplayWarning _ANSI_ARGS_((char *msg,
72 char *title));
73
74 /*
75 * Forward declarations for procedures defined later in this file.
76 */
77
78 static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
79 static void StdinProc _ANSI_ARGS_((ClientData clientData,
80 int mask));
81
82 /*
83 *----------------------------------------------------------------------
84 *
85 * Tk_MainEx --
86 *
87 * Main program for Wish and most other Tk-based applications.
88 *
89 * Results:
90 * None. This procedure never returns (it exits the process when
91 * it's done.
92 *
93 * Side effects:
94 * This procedure initializes the Tk world and then starts
95 * interpreting commands; almost anything could happen, depending
96 * on the script being interpreted.
97 *
98 *----------------------------------------------------------------------
99 */
100 void
101 Tk_MainEx(argc, argv, appInitProc, interp)
102 int argc; /* Number of arguments. */
103 char **argv; /* Array of argument strings. */
104 Tcl_AppInitProc *appInitProc; /* Application-specific initialization
105 * procedure to call after most
106 * initialization but before starting
107 * to execute commands. This input
108 * parameter is ignored because of the
109 * integration of the code automatically
110 * generated by "mktclapp".
111 */
112 Tcl_Interp *interp;
113 {
114 char *args, *fileName;
115 char buf[TCL_INTEGER_SPACE];
116 int code;
117 size_t length;
118 Tcl_Channel inChannel, outChannel;
119 Tcl_DString argString;
120 ThreadSpecificData *tsdPtr;
121 #ifdef __WIN32__
122 HANDLE handle;
123 #endif
124 #if 1
125 /* Dope the environment variables so that the first place the
126 ** run-time code searches for the library files is in the "baked in"
127 ** libraries. Over time, this should be changed to permanently
128 ** bake things in so that this trick isn't necessary.
129 */
130 putenv("TCL_LIBRARY=" ET_TCL_LIBRARY);
131 putenv("TK_LIBRARY=" ET_TK_LIBRARY);
132
133 /* Run the local initialization procedure for the ET module.
134 ** This will dope the interpreter so that attempts to load the
135 ** library files will get redirected internally.
136 */
137
138 Et_DoInit(interp);
139 #endif
140
141 /* appInitProc = Et_DoInit; */
142
143 /*
144 * Ensure that we are getting the matching version of Tcl. This is
145 * really only an issue when Tk is loaded dynamically.
146 */
147
148 if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
149 abort();
150 }
151
152 tsdPtr = (ThreadSpecificData *)
153 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
154
155 Tcl_FindExecutable(argv[0]);
156 tsdPtr->interp = interp;
157
158 #if (defined(__WIN32__) || defined(MAC_TCL))
159 Tk_InitConsoleChannels(interp);
160 #endif
161
162 #ifdef TCL_MEM_DEBUG
163 Tcl_InitMemory(interp);
164 #endif
165
166 /*
167 * Parse command-line arguments. A leading "-file" argument is
168 * ignored (a historical relic from the distant past). If the
169 * next argument doesn't start with a "-" then strip it off and
170 * use it as the name of a script file to process.
171 */
172
173 fileName = TclGetStartupScriptFileName();
174
175 if (argc > 1) {
176 length = strlen(argv[1]);
177 if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
178 argc--;
179 argv++;
180 }
181 }
182 if (fileName == NULL) {
183 if ((argc > 1) && (argv[1][0] != '-')) {
184 fileName = argv[1];
185 argc--;
186 argv++;
187 }
188 }
189
190 /*
191 * Make command-line arguments available in the Tcl variables "argc"
192 * and "argv".
193 */
194
195 args = Tcl_Merge(argc-1, argv+1);
196 Tcl_ExternalToUtfDString(NULL, args, -1, &argString);
197 Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
198 Tcl_DStringFree(&argString);
199 ckfree(args);
200 sprintf(buf, "%d", argc-1);
201
202 if (fileName == NULL) {
203 Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
204 } else {
205 fileName = Tcl_ExternalToUtfDString(NULL, fileName, -1, &argString);
206 }
207 Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
208 Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
209
210 /*
211 * Set the "tcl_interactive" variable.
212 */
213
214 /*
215 * For now, under Windows, we assume we are not running as a console mode
216 * app, so we need to use the GUI console. In order to enable this, we
217 * always claim to be running on a tty. This probably isn't the right
218 * way to do it.
219 */
220
221 #ifdef __WIN32__
222 handle = GetStdHandle(STD_INPUT_HANDLE);
223
224 if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)
225 || (GetFileType(handle) == FILE_TYPE_UNKNOWN)) {
226 /*
227 * If it's a bad or closed handle, then it's been connected
228 * to a wish console window.
229 */
230
231 tsdPtr->tty = 1;
232 } else if (GetFileType(handle) == FILE_TYPE_CHAR) {
233 /*
234 * A character file handle is a tty by definition.
235 */
236
237 tsdPtr->tty = 1;
238 } else {
239 tsdPtr->tty = 0;
240 }
241
242 #else
243 tsdPtr->tty = isatty(0);
244 #endif
245 Tcl_SetVar(interp, "tcl_interactive",
246 ((fileName == NULL) && tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY);
247
248 /*
249 * Invoke application-specific initialization.
250 */
251
252 if ((*appInitProc)(interp) != TCL_OK) {
253 TkpDisplayWarning(Tcl_GetStringResult(interp),
254 "Application initialization failed");
255 }
256
257 /* Register any extensions that should be registered for the
258 ** executable currently being built.
259 */
260 ExtninitInit(interp);
261
262 /* Set a Tcl variable to indicate the particular product
263 ** we are building. This is used in the startup message script
264 ** to announce product version, and may be used other
265 ** places, as well.
266 */
267 Tcl_SetVar(interp,
268 BUILD_CONFIG_PRODUCT_NAME_VARIABLE,
269 BUILD_CONFIG_STATIC_WISH_ALIAS,
270 TCL_GLOBAL_ONLY);
271
272 /* Set Tcl variable to indicate the relese version of the
273 ** product we are building. This is used in the startup message script
274 ** to announce product version, and may be used other
275 ** places, as well.
276 */
277 Tcl_SetVar(interp,
278 BUILD_CONFIG_PRODUCT_VERSION_VARIABLE,
279 BUILD_CONFIG_RELEASE_VERSION,
280 TCL_GLOBAL_ONLY);
281
282 /* Change the title of the console window to reflect
283 ** the product name and version.
284 */
285 Tcl_GlobalEval(interp,
286 "wm title . \""
287 BUILD_CONFIG_STATIC_WISH_ALIAS
288 " v"
289 BUILD_CONFIG_RELEASE_VERSION
290 "\"");
291
292 /* Output the introductory message to the console.
293 ** The script called is generic and applies to both
294 ** IjuScripter and IjuConsole.
295 */
296 Tcl_GlobalEval(interp, BUILD_CONFIG_StartupMessageScript);
297
298 /*
299 * Invoke the script specified on the command line, if any.
300 */
301
302 if (fileName != NULL) {
303 Tcl_ResetResult(interp);
304 code = Tcl_EvalFile(interp, fileName);
305 if (code != TCL_OK) {
306 /*
307 * The following statement guarantees that the errorInfo
308 * variable is set properly.
309 */
310
311 Tcl_AddErrorInfo(interp, "");
312 TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
313 TCL_GLOBAL_ONLY), "Error in startup script");
314 Tcl_DeleteInterp(interp);
315 Tcl_Exit(1);
316 }
317 tsdPtr->tty = 0;
318 } else {
319
320 /*
321 * Evaluate the .rc file, if one has been specified.
322 */
323
324 Tcl_SourceRCFile(interp);
325
326 /*
327 * Establish a channel handler for stdin.
328 */
329
330 inChannel = Tcl_GetStdChannel(TCL_STDIN);
331 if (inChannel) {
332 Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
333 (ClientData) inChannel);
334 }
335 if (tsdPtr->tty) {
336 Prompt(interp, 0);
337 }
338 }
339 Tcl_DStringFree(&argString);
340
341 outChannel = Tcl_GetStdChannel(TCL_STDOUT);
342 if (outChannel) {
343 Tcl_Flush(outChannel);
344 }
345 Tcl_DStringInit(&tsdPtr->command);
346 Tcl_DStringInit(&tsdPtr->line);
347 Tcl_ResetResult(interp);
348
349 /*
350 * Loop infinitely, waiting for commands to execute. When there
351 * are no windows left, Tk_MainLoop returns and we exit.
352 */
353
354 Tk_MainLoop();
355 Tcl_DeleteInterp(interp);
356 Tcl_Exit(0);
357 }
358
359 /*
360 *----------------------------------------------------------------------
361 *
362 * StdinProc --
363 *
364 * This procedure is invoked by the event dispatcher whenever
365 * standard input becomes readable. It grabs the next line of
366 * input characters, adds them to a command being assembled, and
367 * executes the command if it's complete.
368 *
369 * Results:
370 * None.
371 *
372 * Side effects:
373 * Could be almost arbitrary, depending on the command that's
374 * typed.
375 *
376 *----------------------------------------------------------------------
377 */
378
379 /* ARGSUSED */
380 static void
381 StdinProc(clientData, mask)
382 ClientData clientData; /* Not used. */
383 int mask; /* Not used. */
384 {
385 static int gotPartial = 0;
386 char *cmd;
387 int code, count;
388 Tcl_Channel chan = (Tcl_Channel) clientData;
389 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
390 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
391 Tcl_Interp *interp = tsdPtr->interp;
392
393 count = Tcl_Gets(chan, &tsdPtr->line);
394
395 if (count < 0) {
396 if (!gotPartial) {
397 if (tsdPtr->tty) {
398 Tcl_Exit(0);
399 } else {
400 Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
401 }
402 return;
403 }
404 }
405
406 (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
407 &tsdPtr->line), -1);
408 cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
409 Tcl_DStringFree(&tsdPtr->line);
410 if (!Tcl_CommandComplete(cmd)) {
411 gotPartial = 1;
412 goto prompt;
413 }
414 gotPartial = 0;
415
416 /*
417 * Disable the stdin channel handler while evaluating the command;
418 * otherwise if the command re-enters the event loop we might
419 * process commands from stdin before the current command is
420 * finished. Among other things, this will trash the text of the
421 * command being evaluated.
422 */
423
424 Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
425 code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
426
427 chan = Tcl_GetStdChannel(TCL_STDIN);
428 if (chan) {
429 Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
430 (ClientData) chan);
431 }
432 Tcl_DStringFree(&tsdPtr->command);
433 if (Tcl_GetStringResult(interp)[0] != '\0') {
434 if ((code != TCL_OK) || (tsdPtr->tty)) {
435 chan = Tcl_GetStdChannel(TCL_STDOUT);
436 if (chan) {
437 Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
438 Tcl_WriteChars(chan, "\n", 1);
439 }
440 }
441 }
442
443 /*
444 * Output a prompt.
445 */
446
447 prompt:
448 if (tsdPtr->tty) {
449 Prompt(interp, gotPartial);
450 }
451 Tcl_ResetResult(interp);
452 }
453
454 /*
455 *----------------------------------------------------------------------
456 *
457 * Prompt --
458 *
459 * Issue a prompt on standard output, or invoke a script
460 * to issue the prompt.
461 *
462 * Results:
463 * None.
464 *
465 * Side effects:
466 * A prompt gets output, and a Tcl script may be evaluated
467 * in interp.
468 *
469 *----------------------------------------------------------------------
470 */
471
472 static void
473 Prompt(interp, partial)
474 Tcl_Interp *interp; /* Interpreter to use for prompting. */
475 int partial; /* Non-zero means there already
476 * exists a partial command, so use
477 * the secondary prompt. */
478 {
479 char *promptCmd;
480 int code;
481 Tcl_Channel outChannel, errChannel;
482
483 promptCmd = Tcl_GetVar(interp,
484 partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
485 if (promptCmd == NULL) {
486 defaultPrompt:
487 if (!partial) {
488
489 /*
490 * We must check that outChannel is a real channel - it
491 * is possible that someone has transferred stdout out of
492 * this interpreter with "interp transfer".
493 */
494
495 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
496 if (outChannel != (Tcl_Channel) NULL) {
497 Tcl_WriteChars(outChannel, "% ", 2);
498 }
499 }
500 } else {
501 code = Tcl_Eval(interp, promptCmd);
502 if (code != TCL_OK) {
503 Tcl_AddErrorInfo(interp,
504 "\n (script that generates prompt)");
505 /*
506 * We must check that errChannel is a real channel - it
507 * is possible that someone has transferred stderr out of
508 * this interpreter with "interp transfer".
509 */
510
511 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
512 if (errChannel != (Tcl_Channel) NULL) {
513 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
514 Tcl_WriteChars(errChannel, "\n", 1);
515 }
516 goto defaultPrompt;
517 }
518 }
519 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
520 if (outChannel != (Tcl_Channel) NULL) {
521 Tcl_Flush(outChannel);
522 }
523 }
524
525 /* End of tkmain.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25