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

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

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

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