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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.70  
changed lines
  Added in v.71

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25