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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69 - (hide annotations) (download)
Sat Nov 5 10:54:17 2016 UTC (7 years, 8 months ago) by dashley
File MIME type: text/plain
File size: 15240 byte(s)
License and property (keyword) changes.
1 dashley 69 /* $Header$ */
2 dashley 25
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 dashley 69 /* End of tkmain.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25