/[dtapublic]/projs/trunk/shared_source/tcl_base/tclappinit.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/tcl_base/tclappinit.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 29 - (hide annotations) (download)
Sat Oct 8 07:08:47 2016 UTC (7 years, 4 months ago) by dashley
Original Path: to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tclappinit.c
File MIME type: text/plain
File size: 8452 byte(s)
Directories relocated.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclappinit.c,v 1.2 2002/01/27 12:01:32 dtashley Exp $ */
2    
3     /*
4     * tclAppInit.c --
5     *
6     * Provides a default version of the main program and Tcl_AppInit
7     * procedure for Tcl applications (without Tk). Note that this
8     * program must be built in Win32 console mode to work properly.
9     *
10     * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
11     * Copyright (c) 1998-1999 by Scriptics Corporation.
12     *
13     * See the file "license.terms" for information on usage and redistribution
14     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15     *
16     * RCS: @(#) $Id: tclappinit.c,v 1.2 2002/01/27 12:01:32 dtashley Exp $
17     */
18    
19    
20     #include "tcl.h"
21     #include <windows.h>
22     #include <locale.h>
23    
24     #ifdef TCL_TEST
25     extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
26     extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
27     extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
28     extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
29     #ifdef TCL_THREADS
30     extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
31     #endif
32     #endif /* TCL_TEST */
33    
34     static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
35    
36    
37     /*
38     *----------------------------------------------------------------------
39     *
40     * main --
41     *
42     * This is the main program for the application.
43     *
44     * Results:
45     * None: Tcl_Main never returns here, so this procedure never
46     * returns either.
47     *
48     * Side effects:
49     * Whatever the application does.
50     *
51     *----------------------------------------------------------------------
52     */
53    
54     int
55     TclBaseMain(argc, argv)
56     int argc; /* Number of command-line arguments. */
57     char **argv; /* Values of command-line arguments. */
58     {
59     /*
60     * The following #if block allows you to change the AppInit
61     * function by using a #define of TCL_LOCAL_APPINIT instead
62     * of rewriting this entire file. The #if checks for that
63     * #define and uses Tcl_AppInit if it doesn't exist.
64     */
65    
66     #ifndef TCL_LOCAL_APPINIT
67     #define TCL_LOCAL_APPINIT Tcl_AppInit
68     #endif
69     extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
70    
71     /*
72     * The following #if block allows you to change how Tcl finds the startup
73     * script, prime the library or encoding paths, fiddle with the argv,
74     * etc., without needing to rewrite Tcl_Main()
75     */
76    
77     #ifdef TCL_LOCAL_MAIN_HOOK
78     extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
79     #endif
80    
81     char buffer[MAX_PATH +1];
82     char *p;
83     /*
84     * Set up the default locale to be standard "C" locale so parsing
85     * is performed correctly.
86     */
87    
88     setlocale(LC_ALL, "C");
89     setargv(&argc, &argv);
90    
91     /*
92     * Replace argv[0] with full pathname of executable, and forward
93     * slashes substituted for backslashes.
94     */
95    
96     GetModuleFileName(NULL, buffer, sizeof(buffer));
97     argv[0] = buffer;
98     for (p = buffer; *p != '\0'; p++) {
99     if (*p == '\\') {
100     *p = '/';
101     }
102     }
103    
104     #ifdef TCL_LOCAL_MAIN_HOOK
105     TCL_LOCAL_MAIN_HOOK(&argc, &argv);
106     #endif
107    
108     Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
109    
110     return 0; /* Needed only to prevent compiler warning. */
111     }
112    
113    
114     /*
115     *----------------------------------------------------------------------
116     *
117     * Tcl_AppInit --
118     *
119     * This procedure performs application-specific initialization.
120     * Most applications, especially those that incorporate additional
121     * packages, will have their own version of this procedure.
122     *
123     * Results:
124     * Returns a standard Tcl completion code, and leaves an error
125     * message in the interp's result if an error occurs.
126     *
127     * Side effects:
128     * Depends on the startup script.
129     *
130     *----------------------------------------------------------------------
131     */
132    
133     int
134     Tcl_AppInit(interp)
135     Tcl_Interp *interp; /* Interpreter for application. */
136     {
137     if (Tcl_Init(interp) == TCL_ERROR) {
138     return TCL_ERROR;
139     }
140    
141     #ifdef TCL_TEST
142     if (Tcltest_Init(interp) == TCL_ERROR) {
143     return TCL_ERROR;
144     }
145     Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
146     (Tcl_PackageInitProc *) NULL);
147     if (TclObjTest_Init(interp) == TCL_ERROR) {
148     return TCL_ERROR;
149     }
150     #ifdef TCL_THREADS
151     if (TclThread_Init(interp) == TCL_ERROR) {
152     return TCL_ERROR;
153     }
154     #endif
155     if (Procbodytest_Init(interp) == TCL_ERROR) {
156     return TCL_ERROR;
157     }
158     Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
159     Procbodytest_SafeInit);
160     #endif /* TCL_TEST */
161    
162     /*
163     * Call the init procedures for included packages. Each call should
164     * look like this:
165     *
166     * if (Mod_Init(interp) == TCL_ERROR) {
167     * return TCL_ERROR;
168     * }
169     *
170     * where "Mod" is the name of the module.
171     */
172    
173     /*
174     * Call Tcl_CreateCommand for application-specific commands, if
175     * they weren't already created by the init procedures called above.
176     */
177    
178     /*
179     * Specify a user-specific startup file to invoke if the application
180     * is run interactively. Typically the startup file is "~/.apprc"
181     * where "app" is the name of the application. If this line is deleted
182     * then no user-specific startup file will be run under any conditions.
183     */
184    
185     Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
186     return TCL_OK;
187     }
188    
189     /*
190     *-------------------------------------------------------------------------
191     *
192     * setargv --
193     *
194     * Parse the Windows command line string into argc/argv. Done here
195     * because we don't trust the builtin argument parser in crt0.
196     * Windows applications are responsible for breaking their command
197     * line into arguments.
198     *
199     * 2N backslashes + quote -> N backslashes + begin quoted string
200     * 2N + 1 backslashes + quote -> literal
201     * N backslashes + non-quote -> literal
202     * quote + quote in a quoted string -> single quote
203     * quote + quote not in quoted string -> empty string
204     * quote -> begin quoted string
205     *
206     * Results:
207     * Fills argcPtr with the number of arguments and argvPtr with the
208     * array of arguments.
209     *
210     * Side effects:
211     * Memory allocated.
212     *
213     *--------------------------------------------------------------------------
214     */
215    
216     static void
217     setargv(argcPtr, argvPtr)
218     int *argcPtr; /* Filled with number of argument strings. */
219     char ***argvPtr; /* Filled with argument strings (malloc'd). */
220     {
221     char *cmdLine, *p, *arg, *argSpace;
222     char **argv;
223     int argc, size, inquote, copy, slashes;
224    
225     cmdLine = GetCommandLine(); /* INTL: BUG */
226    
227     /*
228     * Precompute an overly pessimistic guess at the number of arguments
229     * in the command line by counting non-space spans.
230     */
231    
232     size = 2;
233     for (p = cmdLine; *p != '\0'; p++) {
234     if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
235     size++;
236     while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
237     p++;
238     }
239     if (*p == '\0') {
240     break;
241     }
242     }
243     }
244     argSpace = (char *) Tcl_Alloc(
245     (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
246     argv = (char **) argSpace;
247     argSpace += size * sizeof(char *);
248     size--;
249    
250     p = cmdLine;
251     for (argc = 0; argc < size; argc++) {
252     argv[argc] = arg = argSpace;
253     while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
254     p++;
255     }
256     if (*p == '\0') {
257     break;
258     }
259    
260     inquote = 0;
261     slashes = 0;
262     while (1) {
263     copy = 1;
264     while (*p == '\\') {
265     slashes++;
266     p++;
267     }
268     if (*p == '"') {
269     if ((slashes & 1) == 0) {
270     copy = 0;
271     if ((inquote) && (p[1] == '"')) {
272     p++;
273     copy = 1;
274     } else {
275     inquote = !inquote;
276     }
277     }
278     slashes >>= 1;
279     }
280    
281     while (slashes) {
282     *arg = '\\';
283     arg++;
284     slashes--;
285     }
286    
287     if ((*p == '\0')
288     || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
289     break;
290     }
291     if (copy != 0) {
292     *arg = *p;
293     arg++;
294     }
295     p++;
296     }
297     *arg = '\0';
298     argSpace = arg + 1;
299     }
300     argv[argc] = NULL;
301    
302     *argcPtr = argc;
303     *argvPtr = argv;
304     }
305    
306    
307     /* $History: tclappInit.c $
308     *
309     * ***************** Version 1 *****************
310     * User: Dtashley Date: 1/02/01 Time: 1:26a
311     * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
312     * Initial check-in.
313     */
314    
315     /* End of TCLAPPINIT.C */
316    

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25