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