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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25